bloodhound 0.14.0.0 → 0.15.0.0

raw patch · 8 files changed

+2616/−48 lines, 8 filesdep ~generics-sopdep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: generics-sop, time

API changes (from Hackage documentation)

Files

• bloodhound.cabal +12/−9
• changelog.md +28/−0
• src/Database/V1/Bloodhound/Client.hs +8/−5
• src/Database/V1/Bloodhound/Types.hs +238/−8
• src/Database/V5/Bloodhound/Client.hs +27/−6
• src/Database/V5/Bloodhound/Types.hs +250/−15
• tests/V1/tests.hs +1949/−0
• tests/V5/tests.hs +104/−5

@@ -1,5 +1,5 @@ name:                bloodhound-version:             0.14.0.0+version:             0.15.0.0 synopsis:            ElasticSearch client library for Haskell description:         ElasticSearch made awesome for Haskell hackers homepage:            https://github.com/bitemyapp/bloodhound@@ -15,6 +15,9 @@ extra-source-files:   README.md   changelog.md+  -- We do this to avoid package check errors when uploading to hackage+  tests/V1/tests.hs+  tests/V5/tests.hs  source-repository head   type:     git@@ -22,11 +25,11 @@  Flag ES1   Description: Run the test suite against an Elasticsearch 1.x server-  Default:     True+  Default:     False  Flag ES5   Description: Run the test suite against an Elasticsearch 5.x server-  Default:     False+  Default:     True  library   ghc-options:         -Wall@@ -48,7 +51,7 @@                        http-client      >= 0.4.30  && <0.6,                        network-uri      >= 2.6     && <2.7,                        semigroups       >= 0.15    && <0.19,-                       time             >= 1.4     && <1.7,+                       time             >= 1.4     && <1.9,                        text             >= 0.11    && <1.3,                        mtl              >= 1.0     && <2.3,                        transformers     >= 0.2     && <0.6,@@ -67,11 +70,11 @@   ghc-options: -Wall -fno-warn-orphans   type: exitcode-stdio-1.0   main-is: tests.hs-  if flag(ES5)-    hs-source-dirs:     tests/V5-  else+  if flag(ES1)     hs-source-dirs:     tests/V1-  +  else+    hs-source-dirs:     tests/V5+   build-depends:       base,                        bloodhound,                        bytestring,@@ -88,7 +91,7 @@                        unordered-containers >= 0.2.5.0 && <0.3,                        mtl,                        quickcheck-properties,-                       generics-sop         >=0.2 && <0.3,+                       generics-sop         >=0.2 && <0.4,                        errors,                        exceptions,                        temporary,

@@ -1,3 +1,31 @@+0.15.0.0+===================++- @jagare+  - #204 Fix bug where Location was used instad of LatLon+  - #207 Add instructions on how to run example code++- @andrewthad+  - #200 Add function for deleting alias+  - #201 Add BulkCreateEncoding, which allows use of aeson's Encoding for faster bulk creates+  - #203 Add support for total fields limit++- @chrissound+  - #196 Add missing import to example++- @tmcgilchrist+  - #186 Fix warnings and drop redundant constraints++- @23Skidoo+  - #183 Bump dependencies to support GHC 8.2++- @bermanjosh+  - #182 Support for Suggesters and Template Queries++- @dawei-dev+  - #181 Fix typo++ 0.14.0.0 =================== 

@@ -151,8 +151,11 @@   initReq <- liftIO $ parseUrl' url   reqHook <- bhRequestHook A.<$> getBHEnv   let reqBody = RequestBodyLBS $ fromMaybe emptyBody body-  req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod-                                                             , requestBody = reqBody }+  req <- liftIO+         $ reqHook+         $ setRequestIgnoreStatus+         $ initReq { method = dMethod+                   , requestBody = reqBody }   mgr <- bhManager <$> getBHEnv   liftIO $ httpLbs req mgr @@ -861,17 +864,17 @@ --   syntax if you want to add things like aggregations or highlights while still using --   this helper function. mkSearch :: Maybe Query -> Maybe Filter -> Search-mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'. mkAggregateSearch :: Maybe Query -> Aggregations -> Search-mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'. mkHighlightSearch :: Maybe Query -> Highlights -> Search-mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'pageSearch' is a helper function that takes a search and assigns the from --    and size fields for the search. The from parameter defines the offset

@@ -195,6 +195,8 @@        , RangeQuery(..)        , RegexpQuery(..)        , QueryString(..)+       , TemplateQueryInline(..)+       , TemplateQueryKeyValuePairs(..)        , BooleanOperator(..)        , ZeroTermsQuery(..)        , CutoffFrequency(..)@@ -322,6 +324,15 @@        , rrGroupRefNum        , mkRRGroupRefNum        , RestoreIndexSettings(..)+       , Suggest(..)+       , SuggestType(..)+       , PhraseSuggester(..)+       , PhraseSuggesterHighlighter(..)+       , PhraseSuggesterCollate(..)+       , mkPhraseSuggester+       , SuggestOptions(..)+       , SuggestResponse(..)+       , NamedSuggestionResponse(..)         , Aggregation(..)        , Aggregations@@ -376,7 +387,8 @@ import           Data.Aeson import           Data.Aeson.Types                      (Pair, Parser,                                                         emptyObject,-                                                        parseEither, parseMaybe)+                                                        parseEither, parseMaybe,+                                                        typeMismatch) import qualified Data.ByteString.Lazy.Char8            as L import           Data.Char import           Data.Hashable                         (Hashable)@@ -1091,7 +1103,7 @@  type TrackSortScores = Bool newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)-newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)+newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)  data Search = Search { queryBody       :: Maybe Query                      , filterBody      :: Maybe Filter@@ -1104,7 +1116,9 @@                      , size            :: Size                      , searchType      :: SearchType                      , fields          :: Maybe [FieldName]-                     , source          :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)+                     , source          :: Maybe Source+                     , suggestBody     :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.+                     } deriving (Eq, Read, Show, Generic, Typeable)  data SearchType = SearchTypeQueryThenFetch                 | SearchTypeDfsQueryThenFetch@@ -1211,6 +1225,7 @@   | QuerySimpleQueryStringQuery SimpleQueryStringQuery   | QueryRangeQuery             RangeQuery   | QueryRegexpQuery            RegexpQuery+  | QueryTemplateQueryInline    TemplateQueryInline   deriving (Eq, Read, Show, Generic, Typeable)  data RegexpQuery =@@ -1635,13 +1650,48 @@   DistanceRange { distanceFrom :: Distance                 , distanceTo   :: Distance } deriving (Eq, Read, Show, Generic, Typeable) +type TemplateQueryKey = Text+type TemplateQueryValue = Text++newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)+  deriving (Eq, Read, Show, Generic, Typeable)++instance ToJSON TemplateQueryKeyValuePairs where+  toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x++instance FromJSON TemplateQueryKeyValuePairs where+  parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o+    where getValue (String x) = Just x+          getValue _          = Nothing+  parseJSON _          = fail "error parsing TemplateQueryKeyValuePairs"++data TemplateQueryInline =+  TemplateQueryInline { inline :: Query+                      , params :: TemplateQueryKeyValuePairs+                      }+  deriving (Eq, Read, Show, Generic, Typeable)++instance ToJSON TemplateQueryInline where+  toJSON TemplateQueryInline{..} = object [ "query" .= inline+                                          , "params" .= params+                                          ]++instance FromJSON TemplateQueryInline where+  parseJSON = withObject "TemplateQueryInline" parse+    where parse o = TemplateQueryInline+                    <$> o .: "query"+                    <*> o .: "params"+ data SearchResult a =   SearchResult { took         :: Int                , timedOut     :: Bool                , shards       :: ShardResult                , searchHits   :: SearchHits a                , aggregations :: Maybe AggregationResults-               , scrollId     :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)+               , scrollId     :: Maybe ScrollId+               , suggest      :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.+               }+  deriving (Eq, Read, Show, Generic, Typeable)  newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON) @@ -2178,7 +2228,7 @@    toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =     object ["missing" .=-            object ["field"       .= fieldName+            object [ "field"      .= fieldName                    , "existence"  .= existence                    , "null_value" .= nullValue]] @@ -2404,6 +2454,9 @@   toJSON (QuerySimpleQueryStringQuery query) =     object [ "simple_query_string" .= query ] +  toJSON (QueryTemplateQueryInline templateQuery) =+    object [ "template" .= templateQuery ]+ instance FromJSON Query where   parseJSON v = withObject "Query" parse v     where parse o = termQuery `taggedWith` "term"@@ -2433,6 +2486,7 @@                 <|> queryRangeQuery `taggedWith` "range"                 <|> queryRegexpQuery `taggedWith` "regexp"                 <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"+                <|> queryTemplateQueryInline `taggedWith` "template"             where taggedWith parser k = parser =<< o .: k           termQuery = fieldTagged $ \(FieldName fn) o ->                         TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"@@ -2474,6 +2528,7 @@           queryRangeQuery = pure . QueryRangeQuery           queryRegexpQuery = pure . QueryRegexpQuery           querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery+          queryTemplateQueryInline = pure . QueryTemplateQueryInline   omitNulls :: [(Text, Value)] -> Value@@ -3412,7 +3467,7 @@     where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)  instance ToJSON Search where-  toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =+  toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =     omitNulls [ "query"        .= query               , "filter"       .= sFilter               , "sort"         .= sort@@ -3422,7 +3477,8 @@               , "size"         .= sSize               , "track_scores" .= sTrackSortScores               , "fields"       .= sFields-              , "_source"      .= sSource]+              , "_source"      .= sSource+              , "suggest"      .= sSuggest]   instance ToJSON Source where@@ -3772,7 +3828,8 @@                          v .:  "_shards"      <*>                          v .:  "hits"         <*>                          v .:? "aggregations" <*>-                         v .:? "_scroll_id"+                         v .:? "_scroll_id"   <*>+                         v .:? "suggest"   parseJSON _          = empty  instance (FromJSON a) => FromJSON (SearchHits a) where@@ -5277,3 +5334,176 @@ instance FromJSON a => FromJSON (MaybeNA a) where   parseJSON (String "NA") = pure $ MaybeNA Nothing   parseJSON o             = MaybeNA . Just <$> parseJSON o+++data Suggest = Suggest { suggestText :: Text+                       , suggestName :: Text+                       , suggestType :: SuggestType+                       }+ deriving (Show, Generic, Eq, Read, Typeable)++instance ToJSON Suggest where+  toJSON Suggest{..} = object [ "text" .= suggestText+                              , suggestName .= suggestType+                              ]++instance FromJSON Suggest where+  parseJSON (Object o) = do+    suggestText' <- o .: "text"+    let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o+    suggestName' <- case dropTextList of+                        [(x, _)] -> return x+                        _ -> fail "error parsing Suggest field name"+    suggestType' <- o .: suggestName'+    return $ Suggest suggestText' suggestName' suggestType'+  parseJSON x = typeMismatch "Suggest" x++data SuggestType = SuggestTypePhraseSuggester PhraseSuggester+  deriving (Show, Generic, Eq, Read, Typeable)++instance ToJSON SuggestType where+  toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]++instance FromJSON SuggestType where+  parseJSON = withObject "SuggestType" parse+    where parse o = phraseSuggester `taggedWith` "phrase"+           where taggedWith parser k = parser =<< o .: k+                 phraseSuggester = pure . SuggestTypePhraseSuggester++data PhraseSuggester =+  PhraseSuggester { phraseSuggesterField :: FieldName+                  , phraseSuggesterGramSize :: Maybe Int+                  , phraseSuggesterRealWordErrorLikelihood :: Maybe Int+                  , phraseSuggesterConfidence :: Maybe Int+                  , phraseSuggesterMaxErrors :: Maybe Int+                  , phraseSuggesterSeparator :: Maybe Text+                  , phraseSuggesterSize :: Maybe Size+                  , phraseSuggesterAnalyzer :: Maybe Analyzer+                  , phraseSuggesterShardSize :: Maybe Int+                  , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter+                  , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate+                  }+  deriving (Show, Generic, Eq, Read, Typeable)++instance ToJSON PhraseSuggester where+  toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField+                                         , "gram_size" .= phraseSuggesterGramSize+                                         , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood+                                         , "confidence" .= phraseSuggesterConfidence+                                         , "max_errors" .= phraseSuggesterMaxErrors+                                         , "separator" .= phraseSuggesterSeparator+                                         , "size" .= phraseSuggesterSize+                                         , "analyzer" .= phraseSuggesterAnalyzer+                                         , "shard_size" .= phraseSuggesterShardSize+                                         , "highlight" .= phraseSuggesterHighlight+                                         , "collate" .= phraseSuggesterCollate+                                        ]++instance FromJSON PhraseSuggester where+  parseJSON = withObject "PhraseSuggester" parse+    where parse o = PhraseSuggester+                      <$> o .: "field"+                      <*> o .:? "gram_size"+                      <*> o .:? "real_word_error_likelihood"+                      <*> o .:? "confidence"+                      <*> o .:? "max_errors"+                      <*> o .:? "separator"+                      <*> o .:? "size"+                      <*> o .:? "analyzer"+                      <*> o .:? "shard_size"+                      <*> o .:? "highlight"+                      <*> o .:? "collate"++mkPhraseSuggester :: FieldName -> PhraseSuggester+mkPhraseSuggester fName =+  PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing++data PhraseSuggesterHighlighter =+  PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text+                             , phraseSuggesterHighlighterPostTag :: Text+                             }+  deriving (Show, Generic, Eq, Read, Typeable)++instance ToJSON PhraseSuggesterHighlighter where+  toJSON PhraseSuggesterHighlighter{..} =+            object [ "pre_tag" .= phraseSuggesterHighlighterPreTag+                   , "post_tag" .= phraseSuggesterHighlighterPostTag+                   ]++instance FromJSON PhraseSuggesterHighlighter where+  parseJSON = withObject "PhraseSuggesterHighlighter" parse+    where parse o = PhraseSuggesterHighlighter+                      <$> o .: "pre_tag"+                      <*> o .: "post_tag"++data PhraseSuggesterCollate =+  PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline+                         , phraseSuggesterCollatePrune :: Bool+                         }+  deriving (Show, Generic, Eq, Read, Typeable)++instance ToJSON PhraseSuggesterCollate where+  toJSON PhraseSuggesterCollate{..} = object [ "query" .= object+                                              [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)+                                              ]+                                             , "params" .= (params phraseSuggesterCollateTemplateQuery)+                                             , "prune" .= phraseSuggesterCollatePrune+                                             ]++instance FromJSON PhraseSuggesterCollate where+  parseJSON (Object o) = do+    query' <- o .: "query"+    inline' <- query' .: "inline"+    params' <- o .: "params"+    prune' <- o .:? "prune" .!= False+    return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'+  parseJSON x = typeMismatch "PhraseSuggesterCollate" x++data SuggestOptions =+  SuggestOptions { suggestOptionsText :: Text+                 , suggestOptionsScore :: Double+                 , suggestOptionsFreq :: Maybe Int+                 , suggestOptionsHighlighted :: Maybe Text+                 }+  deriving (Eq, Read, Show)++instance FromJSON SuggestOptions where+  parseJSON = withObject "SuggestOptions" parse+    where parse o = SuggestOptions+                    <$> o .: "text"+                    <*> o .: "score"+                    <*> o .:? "freq"+                    <*> o .:? "highlighted"++data SuggestResponse =+  SuggestResponse { suggestResponseText :: Text+                  , suggestResponseOffset :: Int+                  , suggestResponseLength :: Int+                  , suggestResponseOptions :: [SuggestOptions]+                  }+  deriving (Eq, Read, Show)++instance FromJSON SuggestResponse where+  parseJSON = withObject "SuggestResponse" parse+    where parse o = SuggestResponse+                    <$> o .: "text"+                    <*> o .: "offset"+                    <*> o .: "length"+                    <*> o .: "options"++data NamedSuggestionResponse =+  NamedSuggestionResponse { nsrName :: Text+                          , nsrResponses :: [SuggestResponse]+                          }+  deriving (Eq, Read, Show)++instance FromJSON NamedSuggestionResponse where+  parseJSON (Object o) = do+    suggestionName' <- case HM.toList o of+                        [(x, _)] -> return x+                        _ -> fail "error parsing NamedSuggestionResponse name"+    suggestionResponses' <- o .: suggestionName'+    return $ NamedSuggestionResponse suggestionName' suggestionResponses'++  parseJSON x = typeMismatch "NamedSuggestionResponse" x

@@ -7,7 +7,7 @@ -- Module : Database.Bloodhound.Client -- Copyright : (C) 2014 Chris Allen -- License : BSD-style (see the file LICENSE)--- Maintainer : Chris Allen <cma@bitemyapp.com+-- Maintainer : Chris Allen <cma@bitemyapp.com> -- Stability : provisional -- Portability : OverloadedStrings --@@ -37,6 +37,7 @@        -- *** Index Aliases        , updateIndexAliases        , getIndexAliases+       , deleteIndexAlias        -- *** Index Templates        , putTemplate        , templateExists@@ -127,6 +128,7 @@ -- >>> :set -XOverloadedStrings -- >>> :set -XDeriveGeneric -- >>> import Database.V5.Bloodhound+-- >>> import Network.HTTP.Client -- >>> let testServer = (Server "http://localhost:9200") -- >>> let runBH' = withBH defaultManagerSettings testServer -- >>> let testIndex = IndexName "twitter"@@ -207,8 +209,15 @@   initReq <- liftIO $ parseUrl' url   reqHook <- bhRequestHook A.<$> getBHEnv   let reqBody = RequestBodyLBS $ fromMaybe emptyBody body-  req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod-                                                             , requestBody = reqBody }+  req <- liftIO+         $ reqHook+         $ setRequestIgnoreStatus+         $ initReq { method = dMethod+                   , requestHeaders =+                     ("Content-Type", "application/json") : requestHeaders initReq+                   , requestBody = reqBody }+  -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod+  --                                                            , requestBody = reqBody }   mgr <- bhManager <$> getBHEnv   liftIO $ httpLbs req mgr @@ -710,6 +719,12 @@ getIndexAliases = parseEsResponse =<< get =<< url   where url = joinPath ["_aliases"] +-- | Delete a single alias, removing it from all indices it+--   is currently associated with.+deleteIndexAlias :: MonadBH m => IndexAliasName -> m Reply+deleteIndexAlias (IndexAliasName (IndexName name)) = delete =<< url+  where url = joinPath ["_all","_alias",name]+ -- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'. --   Explained in further detail at --   <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>@@ -878,6 +893,12 @@           doc = object ["doc" .= value]           blob = encode metadata `mappend` "\n" `mappend` encode doc +encodeBulkOperation (BulkCreateEncoding (IndexName indexName)+                (MappingName mappingName)+                (DocId docId) encoding) = toLazyByteString blob+    where metadata = toEncoding (mkBulkStreamValue "create" indexName mappingName docId)+          blob = fromEncoding metadata <> "\n" <> fromEncoding encoding+ -- | 'getDocument' is a straight-forward way to fetch a single document from --   Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'. --   The 'DocId' is the primary key for your Elasticsearch document.@@ -1044,7 +1065,7 @@ -- >>> mkSearch (Just query) Nothing -- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing} mkSearch :: Maybe Query -> Maybe Filter -> Search-mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'.@@ -1054,7 +1075,7 @@ -- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing}) -- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms mkAggregateSearch :: Maybe Query -> Aggregations -> Search-mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'.@@ -1063,7 +1084,7 @@ -- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing] -- >>> let search = mkHighlightSearch (Just query) testHighlight mkHighlightSearch :: Maybe Query -> Highlights -> Search-mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing  -- | 'pageSearch' is a helper function that takes a search and assigns the from --    and size fields for the search. The from parameter defines the offset

@@ -196,6 +196,8 @@        , RangeQuery(..)        , RegexpQuery(..)        , QueryString(..)+       , TemplateQueryInline(..)+       , TemplateQueryKeyValuePairs(..)        , BooleanOperator(..)        , ZeroTermsQuery(..)        , CutoffFrequency(..)@@ -323,6 +325,15 @@        , rrGroupRefNum        , mkRRGroupRefNum        , RestoreIndexSettings(..)+       , Suggest(..)+       , SuggestType(..)+       , PhraseSuggester(..)+       , PhraseSuggesterHighlighter(..)+       , PhraseSuggesterCollate(..)+       , mkPhraseSuggester+       , SuggestOptions(..)+       , SuggestResponse(..)+       , NamedSuggestionResponse(..)         , Aggregation(..)        , Aggregations@@ -378,7 +389,8 @@ import           Data.Aeson import           Data.Aeson.Types                      (Pair, Parser,                                                         emptyObject,-                                                        parseEither, parseMaybe)+                                                        parseEither, parseMaybe,+                                                        typeMismatch) import qualified Data.ByteString.Lazy.Char8            as L import           Data.Char import           Data.Hashable                         (Hashable)@@ -570,6 +582,7 @@                            | IndexCompoundFormat CompoundFormat                            | IndexCompoundOnFlush Bool                            | WarmerEnabled Bool+                           | MappingTotalFieldsLimit Int                            deriving (Eq, Show, Generic, Typeable)  data AllocationPolicy = AllocAll@@ -698,8 +711,9 @@ data BulkOperation =     BulkIndex  IndexName MappingName DocId Value   | BulkCreate IndexName MappingName DocId Value+  | BulkCreateEncoding IndexName MappingName DocId Encoding   | BulkDelete IndexName MappingName DocId-  | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)+  | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show, Generic, Typeable)  {-| 'EsResult' describes the standard wrapper JSON document that you see in     successful Elasticsearch lookups or lookups that couldn't find the document.@@ -910,7 +924,7 @@  {-| 'PrefixValue' is used in 'PrefixQuery' as the main query component. -}-type PrefixValue = Text+-- type PrefixValue = Text  {-| 'BooleanOperator' is the usual And/Or operators with an ES compatible     JSON encoding baked in. Used all over the place.@@ -1095,7 +1109,7 @@  type TrackSortScores = Bool newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)-newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)+newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON)  data Search = Search { queryBody       :: Maybe Query                      , filterBody      :: Maybe Filter@@ -1108,7 +1122,9 @@                      , size            :: Size                      , searchType      :: SearchType                      , fields          :: Maybe [FieldName]-                     , source          :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)+                     , source          :: Maybe Source+                     , suggestBody     :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.+                     } deriving (Eq, Read, Show, Generic, Typeable)  data SearchType = SearchTypeQueryThenFetch                 | SearchTypeDfsQueryThenFetch@@ -1211,6 +1227,7 @@   | QueryRegexpQuery            RegexpQuery   | QueryExistsQuery            FieldName   | QueryMatchNoneQuery+  | QueryTemplateQueryInline    TemplateQueryInline   deriving (Eq, Read, Show, Generic, Typeable)  -- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a Bool Query, and@@ -1622,13 +1639,49 @@   DistanceRange { distanceFrom :: Distance                 , distanceTo   :: Distance } deriving (Eq, Read, Show, Generic, Typeable) +type TemplateQueryKey = Text+type TemplateQueryValue = Text++newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)+  deriving (Eq, Read, Show, Generic)++instance ToJSON TemplateQueryKeyValuePairs where+  toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x++instance FromJSON TemplateQueryKeyValuePairs where+  parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o+    where getValue (String x) = Just x+          getValue _          = Nothing+  parseJSON _          = fail "error parsing TemplateQueryKeyValuePairs"++data TemplateQueryInline =+  TemplateQueryInline { inline :: Query+                      , params :: TemplateQueryKeyValuePairs+                      }+  deriving (Eq, Read, Show, Generic, Typeable)++instance ToJSON TemplateQueryInline where+  toJSON TemplateQueryInline{..} = object [ "inline" .= inline+                                          , "params" .= params+                                          ]++instance FromJSON TemplateQueryInline where+  parseJSON = withObject "TemplateQueryInline" parse+    where parse o = TemplateQueryInline+                    <$> o .: "inline"+                    <*> o .: "params"++ data SearchResult a =   SearchResult { took         :: Int                , timedOut     :: Bool                , shards       :: ShardResult                , searchHits   :: SearchHits a                , aggregations :: Maybe AggregationResults-               , scrollId     :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)+               , scrollId     :: Maybe ScrollId+               , suggest      :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.+               }+  deriving (Eq, Read, Show, Generic, Typeable)  newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON) @@ -2047,7 +2100,7 @@   docCount = dateRangeDocCount   aggs = dateRangeAggs -instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where+instance (FromJSON a) => FromJSON (Bucket a) where   parseJSON (Object v) = Bucket <$>                          v .: "buckets"   parseJSON _ = mempty@@ -2220,6 +2273,9 @@   toJSON QueryMatchNoneQuery =     object ["match_none" .= object []] +  toJSON (QueryTemplateQueryInline templateQuery) =+    object [ "template" .= templateQuery ]+ instance FromJSON Query where   parseJSON v = withObject "Query" parse v     where parse o = termQuery `taggedWith` "term"@@ -2247,6 +2303,7 @@                 <|> queryRangeQuery `taggedWith` "range"                 <|> queryRegexpQuery `taggedWith` "regexp"                 <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"+                <|> queryTemplateQueryInline `taggedWith` "template"             where taggedWith parser k = parser =<< o .: k           termQuery = fieldTagged $ \(FieldName fn) o ->                         TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"@@ -2283,7 +2340,8 @@           queryRangeQuery = pure . QueryRangeQuery           queryRegexpQuery = pure . QueryRegexpQuery           querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery-          queryExistsQuery o = QueryExistsQuery <$> o .: "field"+          -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"+          queryTemplateQueryInline = pure . QueryTemplateQueryInline   omitNulls :: [(Text, Value)] -> Value@@ -2751,10 +2809,10 @@                     <*> o .: "negative_boost"  instance ToJSON BoolQuery where-  toJSON (BoolQuery mustM filterM notM shouldM bqMin boost disableCoord) =+  toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =     omitNulls base     where base = [ "must" .= mustM-                 , "filter" .= filterM+                 , "filter" .= filterM'                  , "must_not" .= notM                  , "should" .= shouldM                  , "minimum_should_match" .= bqMin@@ -2810,7 +2868,7 @@                  , "query" .= query                  , "operator" .= boolOp                  , "zero_terms_query" .= ztQ-                 , "tiebreaker" .= tb+                 , "tie_breaker" .= tb                  , "type" .= mmqt                  , "cutoff_frequency" .= cf                  , "analyzer" .= analyzer@@ -2825,7 +2883,7 @@                            <*> o .: "query"                            <*> o .: "operator"                            <*> o .: "zero_terms_query"-                           <*> o .:? "tiebreaker"+                           <*> o .:? "tie_breaker"                            <*> o .:? "type"                            <*> o .:? "cutoff_frequency"                            <*> o .:? "analyzer"@@ -2931,6 +2989,7 @@   toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x   toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x   toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x+  toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x  instance FromJSON UpdatableIndexSetting where   parseJSON = withObject "UpdatableIndexSetting" parse@@ -2962,6 +3021,7 @@                 <|> blocksRead `taggedAt` ["blocks", "read"]                 <|> blocksWrite `taggedAt` ["blocks", "write"]                 <|> blocksMetaData `taggedAt` ["blocks", "metadata"]+                <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]             where taggedAt f ks = taggedAt' f (Object o) ks           taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))           taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k@@ -2994,6 +3054,7 @@           blocksRead                     = pure . BlocksRead           blocksWrite                    = pure . BlocksWrite           blocksMetaData                 = pure . BlocksMetaData+          mappingTotalFieldsLimit        = pure . MappingTotalFieldsLimit  instance FromJSON IndexSettingsSummary where   parseJSON = withObject "IndexSettingsSummary" parse@@ -3212,7 +3273,7 @@     where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)  instance ToJSON Search where-  toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =+  toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =     omitNulls [ "query"        .= query'               , "sort"         .= sort               , "aggregations" .= searchAggs@@ -3221,7 +3282,8 @@               , "size"         .= sSize               , "track_scores" .= sTrackSortScores               , "fields"       .= sFields-              , "_source"      .= sSource]+              , "_source"      .= sSource+              , "suggest"      .= sSuggest]      where query' = case sFilter of                     Nothing -> mquery@@ -3574,7 +3636,8 @@                          v .:  "_shards"      <*>                          v .:  "hits"         <*>                          v .:? "aggregations" <*>-                         v .:? "_scroll_id"+                         v .:? "_scroll_id"   <*>+                         v .:? "suggest"   parseJSON _          = empty  instance (FromJSON a) => FromJSON (SearchHits a) where@@ -5055,3 +5118,175 @@ instance FromJSON a => FromJSON (MaybeNA a) where   parseJSON (String "NA") = pure $ MaybeNA Nothing   parseJSON o             = MaybeNA . Just <$> parseJSON o++data Suggest = Suggest { suggestText :: Text+                       , suggestName :: Text+                       , suggestType :: SuggestType+                       }+ deriving (Show, Generic, Eq, Read)++instance ToJSON Suggest where+  toJSON Suggest{..} = object [ "text" .= suggestText+                              , suggestName .= suggestType+                              ]++instance FromJSON Suggest where+  parseJSON (Object o) = do+    suggestText' <- o .: "text"+    let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o+    suggestName' <- case dropTextList of+                        [(x, _)] -> return x+                        _ -> fail "error parsing Suggest field name"+    suggestType' <- o .: suggestName'+    return $ Suggest suggestText' suggestName' suggestType'+  parseJSON x = typeMismatch "Suggest" x++data SuggestType = SuggestTypePhraseSuggester PhraseSuggester+  deriving (Show, Generic, Eq, Read)++instance ToJSON SuggestType where+  toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]++instance FromJSON SuggestType where+  parseJSON = withObject "SuggestType" parse+    where parse o = phraseSuggester `taggedWith` "phrase"+           where taggedWith parser k = parser =<< o .: k+                 phraseSuggester = pure . SuggestTypePhraseSuggester++data PhraseSuggester =+  PhraseSuggester { phraseSuggesterField :: FieldName+                  , phraseSuggesterGramSize :: Maybe Int+                  , phraseSuggesterRealWordErrorLikelihood :: Maybe Int+                  , phraseSuggesterConfidence :: Maybe Int+                  , phraseSuggesterMaxErrors :: Maybe Int+                  , phraseSuggesterSeparator :: Maybe Text+                  , phraseSuggesterSize :: Maybe Size+                  , phraseSuggesterAnalyzer :: Maybe Analyzer+                  , phraseSuggesterShardSize :: Maybe Int+                  , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter+                  , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate+                  }+  deriving (Show, Generic, Eq, Read)++instance ToJSON PhraseSuggester where+  toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField+                                         , "gram_size" .= phraseSuggesterGramSize+                                         , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood+                                         , "confidence" .= phraseSuggesterConfidence+                                         , "max_errors" .= phraseSuggesterMaxErrors+                                         , "separator" .= phraseSuggesterSeparator+                                         , "size" .= phraseSuggesterSize+                                         , "analyzer" .= phraseSuggesterAnalyzer+                                         , "shard_size" .= phraseSuggesterShardSize+                                         , "highlight" .= phraseSuggesterHighlight+                                         , "collate" .= phraseSuggesterCollate+                                        ]++instance FromJSON PhraseSuggester where+  parseJSON = withObject "PhraseSuggester" parse+    where parse o = PhraseSuggester+                      <$> o .: "field"+                      <*> o .:? "gram_size"+                      <*> o .:? "real_word_error_likelihood"+                      <*> o .:? "confidence"+                      <*> o .:? "max_errors"+                      <*> o .:? "separator"+                      <*> o .:? "size"+                      <*> o .:? "analyzer"+                      <*> o .:? "shard_size"+                      <*> o .:? "highlight"+                      <*> o .:? "collate"++mkPhraseSuggester :: FieldName -> PhraseSuggester+mkPhraseSuggester fName =+  PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing++data PhraseSuggesterHighlighter =+  PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text+                             , phraseSuggesterHighlighterPostTag :: Text+                             }+  deriving (Show, Generic, Eq, Read)++instance ToJSON PhraseSuggesterHighlighter where+  toJSON PhraseSuggesterHighlighter{..} =+            object [ "pre_tag" .= phraseSuggesterHighlighterPreTag+                   , "post_tag" .= phraseSuggesterHighlighterPostTag+                   ]++instance FromJSON PhraseSuggesterHighlighter where+  parseJSON = withObject "PhraseSuggesterHighlighter" parse+    where parse o = PhraseSuggesterHighlighter+                      <$> o .: "pre_tag"+                      <*> o .: "post_tag"++data PhraseSuggesterCollate =+  PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline+                         , phraseSuggesterCollatePrune :: Bool+                         }+  deriving (Show, Generic, Eq, Read)++instance ToJSON PhraseSuggesterCollate where+  toJSON PhraseSuggesterCollate{..} = object [ "query" .= object+                                              [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)+                                              ]+                                             , "params" .= (params phraseSuggesterCollateTemplateQuery)+                                             , "prune" .= phraseSuggesterCollatePrune+                                             ]++instance FromJSON PhraseSuggesterCollate where+  parseJSON (Object o) = do+    query' <- o .: "query"+    inline' <- query' .: "inline"+    params' <- o .: "params"+    prune' <- o .:? "prune" .!= False+    return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'+  parseJSON x = typeMismatch "PhraseSuggesterCollate" x++data SuggestOptions =+  SuggestOptions { suggestOptionsText :: Text+                 , suggestOptionsScore :: Double+                 , suggestOptionsFreq :: Maybe Int+                 , suggestOptionsHighlighted :: Maybe Text+                 }+  deriving (Eq, Read, Show)++instance FromJSON SuggestOptions where+  parseJSON = withObject "SuggestOptions" parse+    where parse o = SuggestOptions+                    <$> o .: "text"+                    <*> o .: "score"+                    <*> o .:? "freq"+                    <*> o .:? "highlighted"++data SuggestResponse =+  SuggestResponse { suggestResponseText :: Text+                  , suggestResponseOffset :: Int+                  , suggestResponseLength :: Int+                  , suggestResponseOptions :: [SuggestOptions]+                  }+  deriving (Eq, Read, Show)++instance FromJSON SuggestResponse where+  parseJSON = withObject "SuggestResponse" parse+    where parse o = SuggestResponse+                    <$> o .: "text"+                    <*> o .: "offset"+                    <*> o .: "length"+                    <*> o .: "options"++data NamedSuggestionResponse =+  NamedSuggestionResponse { nsrName :: Text+                          , nsrResponses :: [SuggestResponse]+                          }+  deriving (Eq, Read, Show)++instance FromJSON NamedSuggestionResponse where+  parseJSON (Object o) = do+    suggestionName' <- case HM.toList o of+                        [(x, _)] -> return x+                        _ -> fail "error parsing NamedSuggestionResponse name"+    suggestionResponses' <- o .: suggestionName'+    return $ NamedSuggestionResponse suggestionName' suggestionResponses'++  parseJSON x = typeMismatch "NamedSuggestionResponse" x

@@ -0,0 +1,1949 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeOperators              #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ < 800+{-# OPTIONS_GHC -fcontext-stack=100 #-}+#endif+#if __GLASGOW_HASKELL__ >= 802+{-# LANGUAGE MonoLocalBinds #-}+#endif+module Main where++import           Control.Applicative+import           Control.Error+import           Control.Exception               (evaluate)+import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.Reader+import           Data.Aeson+import           Data.Aeson.Types                (parseEither)+import qualified Data.ByteString.Lazy.Char8      as BL8+import qualified Data.HashMap.Strict             as HM+import           Data.List                       (nub)+import qualified Data.List                       as L+import           Data.List.NonEmpty              (NonEmpty (..))+import qualified Data.List.NonEmpty              as NE+import qualified Data.Map.Strict                 as M+import           Data.Monoid+import           Data.Ord                        (comparing)+import           Data.Proxy+import           Data.Text                       (Text)+import qualified Data.Text                       as T+import           Data.Time.Calendar              (Day (..), fromGregorian)+import           Data.Time.Clock                 (NominalDiffTime, UTCTime (..),+                                                  secondsToDiffTime)+import           Data.Typeable+import qualified Data.Vector                     as V+import qualified Data.Version                    as Vers+import           Database.V1.Bloodhound+import           GHC.Generics                    as G+import           Network.HTTP.Client             hiding (Proxy)+import qualified Network.HTTP.Types.Method       as NHTM+import qualified Network.HTTP.Types.Status       as NHTS+import qualified Network.URI                     as URI+import           Prelude                         hiding (filter)+import           System.IO.Temp+import           System.PosixCompat.Files+import           Test.Hspec+import           Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)++import           Test.Hspec.QuickCheck           (prop)+import           Test.QuickCheck++import qualified Generics.SOP as SOP+import qualified Generics.SOP.GGP as SOP++testServer  :: Server+testServer  = Server "http://localhost:9200"+testIndex   :: IndexName+testIndex   = IndexName "bloodhound-tests-twitter-1"+testMapping :: MappingName+testMapping = MappingName "tweet"++withTestEnv :: BH IO a -> IO a+withTestEnv = withBH defaultManagerSettings testServer++validateStatus :: Show body => Response body -> Int -> Expectation+validateStatus resp expected =+  if actual == expected+    then return ()+    else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)+  where+    actual = NHTS.statusCode (responseStatus resp)+    body = responseBody resp++createExampleIndex :: (MonadBH m) => m Reply+createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex+deleteExampleIndex :: (MonadBH m) => m Reply+deleteExampleIndex = deleteIndex testIndex++es13 :: Vers.Version+es13 = Vers.Version [1, 3, 0] []++es12 :: Vers.Version+es12 = Vers.Version [1, 2, 0] []++es11 :: Vers.Version+es11 = Vers.Version [1, 1, 0] []++es14 :: Vers.Version+es14 = Vers.Version [1, 4, 0] []++es15 :: Vers.Version+es15 = Vers.Version [1, 5, 0] []++es16 :: Vers.Version+es16 = Vers.Version [1, 6, 0] []++es20 :: Vers.Version+es20 = Vers.Version [2, 0, 0] []++getServerVersion :: IO (Maybe Vers.Version)+getServerVersion = fmap extractVersion <$> withTestEnv getStatus+  where+    extractVersion              = versionNumber . number . version++-- | Get configured repo paths for snapshotting. Note that by default+-- this is not enabled and if we are over es 1.5, we won't be able to+-- test snapshotting. Note that this can and should be part of the+-- client functionality in a much less ad-hoc incarnation.+getRepoPaths :: IO [FilePath]+getRepoPaths = withTestEnv $ do+  bhe <- getBHEnv+  let Server s = bhServer bhe+  let tUrl = s <> "/" <> "_nodes"+  initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))+  let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }+  Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))+  return $ fromMaybe mempty $ do+    Object nodes <- HM.lookup "nodes" o+    Object firstNode <- snd <$> headMay (HM.toList nodes)+    Object settings <- HM.lookup "settings" firstNode+    Object path <- HM.lookup "path" settings+    Array repo <- HM.lookup "repo" path+    return [ T.unpack t | String t <- V.toList repo]++-- | 1.5 and earlier don't care about repo paths+canSnapshot :: IO Bool+canSnapshot = do+  caresAboutRepos <- atleast es16+  repoPaths <- getRepoPaths+  return (not caresAboutRepos || not (null (repoPaths)))++atleast :: Vers.Version -> IO Bool+atleast v = getServerVersion >>= \x -> return $ x >= Just v++atmost :: Vers.Version -> IO Bool+atmost v = getServerVersion >>= \x -> return $ x <= Just v++is :: Vers.Version -> IO Bool+is v = getServerVersion >>= \x -> return $ x == Just v++when' :: Monad m => m Bool -> m () -> m ()+when' b f = b >>= \x -> when x f++(==~) :: (ApproxEq a) => a -> a -> Property+a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)++propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec+propJSON _ = prop testName $ \(a :: a) ->+  let jsonStr = "via " <> BL8.unpack (encode a)+  in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)+  where testName = show ty <> " FromJSON/ToJSON roundtrips"+        ty = typeOf (undefined :: a)++data Location = Location { lat :: Double+                         , lon :: Double } deriving (Eq, Generic, Show)++data Tweet = Tweet { user     :: Text+                   , postDate :: UTCTime+                   , message  :: Text+                   , age      :: Int+                   , location :: Location+                   , extra    :: Maybe Text }+           deriving (Eq, Generic, Show)++instance ToJSON   Tweet where+  toJSON = genericToJSON defaultOptions+instance FromJSON Tweet where+  parseJSON = genericParseJSON defaultOptions+instance ToJSON   Location where+  toJSON = genericToJSON defaultOptions+instance FromJSON Location where+  parseJSON = genericParseJSON defaultOptions++data ParentMapping = ParentMapping deriving (Eq, Show)++instance ToJSON ParentMapping where+  toJSON ParentMapping =+    object ["properties" .=+      object [ "user"     .= object ["type"    .= ("string" :: Text)]+            -- Serializing the date as a date is breaking other tests, mysteriously.+            -- , "postDate" .= object [ "type"   .= ("date" :: Text)+            --                        , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]+            , "message"  .= object ["type" .= ("string" :: Text)]+            , "age"      .= object ["type" .= ("integer" :: Text)]+            , "location" .= object ["type" .= ("geo_point" :: Text)]+            ]]++data ChildMapping = ChildMapping deriving (Eq, Show)++instance ToJSON ChildMapping where+  toJSON ChildMapping =+    object ["_parent" .= object ["type" .= ("parent" :: Text)]+           , "properties" .=+                object [ "user"     .= object ["type"    .= ("string" :: Text)]+                  -- Serializing the date as a date is breaking other tests, mysteriously.+                  -- , "postDate" .= object [ "type"   .= ("date" :: Text)+                  --                        , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]+                  , "message"  .= object ["type" .= ("string" :: Text)]+                  , "age"      .= object ["type" .= ("integer" :: Text)]+                  , "location" .= object ["type" .= ("geo_point" :: Text)]+                  ]]++data TweetMapping = TweetMapping deriving (Eq, Show)++instance ToJSON TweetMapping where+  toJSON TweetMapping =+    object ["properties" .=+      object [ "user"     .= object ["type"    .= ("string" :: Text)]+             -- Serializing the date as a date is breaking other tests, mysteriously.+             -- , "postDate" .= object [ "type"   .= ("date" :: Text)+             --                        , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]+             , "message"  .= object ["type" .= ("string" :: Text)]+             , "age"      .= object ["type" .= ("integer" :: Text)]+             , "location" .= object ["type" .= ("geo_point" :: Text)]+             ]]++exampleTweet :: Tweet+exampleTweet = Tweet { user     = "bitemyapp"+                     , postDate = UTCTime+                                  (ModifiedJulianDay 55000)+                                  (secondsToDiffTime 10)+                     , message  = "Use haskell!"+                     , age      = 10000+                     , location = Location 40.12 (-71.34)+                     , extra = Nothing }++tweetWithExtra :: Tweet+tweetWithExtra = Tweet { user     = "bitemyapp"+                       , postDate = UTCTime+                                    (ModifiedJulianDay 55000)+                                    (secondsToDiffTime 10)+                       , message  = "Use haskell!"+                       , age      = 10000+                       , location = Location 40.12 (-71.34)+                       , extra = Just "blah blah" }++newAge :: Int+newAge = 31337++newUser :: Text+newUser = "someotherapp"++tweetPatch :: Value+tweetPatch =+  object [ "age" .= newAge+         , "user" .= newUser+         ]++patchedTweet :: Tweet+patchedTweet = exampleTweet{age = newAge, user = newUser}++otherTweet :: Tweet+otherTweet = Tweet { user     = "notmyapp"+                   , postDate = UTCTime+                                (ModifiedJulianDay 55000)+                                (secondsToDiffTime 11)+                   , message  = "Use haskell!"+                   , age      = 1000+                   , location = Location 40.12 (-71.34)+                   , extra = Nothing }++resetIndex :: BH IO ()+resetIndex = do+  _ <- deleteExampleIndex+  _ <- createExampleIndex+  _ <- putMapping testIndex testMapping TweetMapping+  return ()++insertData :: BH IO Reply+insertData = do+  resetIndex+  insertData' defaultIndexDocumentSettings++insertData' :: IndexDocumentSettings -> BH IO Reply+insertData' ids = do+  r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")+  _ <- refreshIndex testIndex+  return r++updateData :: BH IO Reply+updateData = do+  r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")+  _ <- refreshIndex testIndex+  return r++insertOther :: BH IO ()+insertOther = do+  _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")+  _ <- refreshIndex testIndex+  return ()++insertExtra :: BH IO ()+insertExtra = do+  _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")+  _ <- refreshIndex testIndex+  return ()++insertWithSpaceInId :: BH IO ()+insertWithSpaceInId = do+  _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")+  _ <- refreshIndex testIndex+  return ()++searchTweet :: Search -> BH IO (Either EsError Tweet)+searchTweet search = do+  result <- searchTweets search+  let myTweet :: Either EsError Tweet+      myTweet = grabFirst result+  return myTweet++searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))+searchTweets search = parseEsResponse =<< searchByIndex testIndex search++searchExpectNoResults :: Search -> BH IO ()+searchExpectNoResults search = do+  result <- searchTweets search+  let emptyHits = fmap (hits . searchHits) result+  liftIO $+    emptyHits `shouldBe` Right []++searchExpectAggs :: Search -> BH IO ()+searchExpectAggs search = do+  reply <- searchByIndex testIndex search+  let isEmpty x = return (M.null x)+  let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)+  liftIO $+    (result >>= aggregations >>= isEmpty) `shouldBe` Just False++searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>+                        Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()+searchValidBucketAgg search aggKey extractor = do+  reply <- searchByIndex testIndex search+  let bucketDocs = docCount . head . buckets+  let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)+  let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)+  liftIO $+    count `shouldBe` Just 1++searchTermsAggHint :: [ExecutionHint] -> BH IO ()+searchTermsAggHint hints = do+      let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }+      let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint+      forM_ hints $ searchExpectAggs . search+      forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)++searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))+searchTweetHighlight search = do+  result <- searchTweets search+  let myHighlight = fmap (hitHighlight . head . hits . searchHits) result+  return myHighlight++searchExpectSource :: Source -> Either EsError Value -> BH IO ()+searchExpectSource src expected = do+  _ <- insertData+  let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")+  let search = (mkSearch (Just query) Nothing) { source = Just src }+  reply <- searchByIndex testIndex search+  result <- parseEsResponse reply+  let value = grabFirst result+  liftIO $+    value `shouldBe` expected++withSnapshotRepo+    :: ( MonadMask m+       , MonadBH m+       )+    => SnapshotRepoName+    -> (GenericSnapshotRepo -> m a)+    -> m a+withSnapshotRepo srn@(SnapshotRepoName n) f = do+  repoPaths <- liftIO getRepoPaths+  -- we'll use the first repo path if available, otherwise system temp+  -- dir. Note that this will fail on ES > 1.6, so be sure you use+  -- @when' canSnapshot@.+  case repoPaths of+    (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f+    [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f+  where+    alloc dir = do+      liftIO (setFileMode dir mode)+      let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing+      resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo+      liftIO (validateStatus resp 200)+      return (toGSnapshotRepo repo)+    mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes+    free GenericSnapshotRepo {..} = do+      resp <- deleteSnapshotRepo gSnapshotRepoName+      liftIO (validateStatus resp 200)+++withSnapshot+    :: ( MonadMask m+       , MonadBH m+       )+    => SnapshotRepoName+    -> SnapshotName+    -> m a+    -> m a+withSnapshot srn sn = bracket_ alloc free+  where+    alloc = do+      resp <- createSnapshot srn sn createSettings+      liftIO (validateStatus resp 200)+    -- We'll make this synchronous for testing purposes+    createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True+                                                   , snapIndices = Just (IndexList (testIndex :| []))+                                                   -- We don't actually need to back up any data+                                                   }+    free = do+      deleteSnapshot srn sn++++data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)+instance FromJSON BulkTest where+  parseJSON = genericParseJSON defaultOptions+instance ToJSON BulkTest where+  toJSON = genericToJSON defaultOptions++class GApproxEq f where+  gApproxEq :: f a -> f a -> Bool++-- | Unit type+instance GApproxEq U1 where+  gApproxEq U1 U1 = True++-- | Sum type, ensure same constructors, recurse+instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where+  gApproxEq (L1 a) (L1 b) = gApproxEq a b+  gApproxEq (R1 a) (R1 b) = gApproxEq a b+  gApproxEq _ _           = False++-- | Product type, ensure each field is approx eq+instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where+  gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2++-- | Value type, actually check the values for approx equality+instance (ApproxEq a) => GApproxEq (K1 i a) where+  gApproxEq (K1 a) (K1 b) = a =~ b++instance (GApproxEq f) => GApproxEq (M1 i t f) where+  gApproxEq (M1 a) (M1 b) = gApproxEq a b++-- | Typeclass for "equal where it matters". Use this to specify+-- less-strict equivalence for things such as lists that can wind up+-- in an unpredictable order+class ApproxEq a where+  (=~) :: a -> a -> Bool+  default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool+  a =~ b = gApproxEq (G.from a) (G.from b)++  showApproxEq :: a -> String+  default showApproxEq :: (Show a) => a -> String+  showApproxEq = show++instance ApproxEq NominalDiffTime where (=~) = (==)+instance ApproxEq UTCTime where (=~) = (==)+instance ApproxEq Text where (=~) = (==)+instance ApproxEq Bool where (=~) = (==)+instance ApproxEq Int where (=~) = (==)+instance ApproxEq Double where (=~) = (==)+instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)+instance (ApproxEq a, Show a) => ApproxEq (Maybe a)+instance ApproxEq GeoPoint+instance ApproxEq Regexp+instance ApproxEq RangeValue+instance ApproxEq LessThan+instance ApproxEq LessThanEq+instance ApproxEq LessThanD+instance ApproxEq LessThanEqD+instance ApproxEq GreaterThan+instance ApproxEq GreaterThanEq+instance ApproxEq GreaterThanD+instance ApproxEq GreaterThanEqD+instance ApproxEq MinimumMatchHighLow+instance ApproxEq RegexpFlag+instance ApproxEq RegexpFlags+instance ApproxEq NullValue+instance ApproxEq Version+instance ApproxEq VersionNumber+instance ApproxEq DistanceRange+instance ApproxEq IndexName+instance ApproxEq MappingName+instance ApproxEq DocId+instance ApproxEq IndexAliasRouting+instance ApproxEq RoutingValue+instance ApproxEq ShardCount+instance ApproxEq ReplicaCount+instance ApproxEq TemplateName+instance ApproxEq TemplatePattern+instance ApproxEq QueryString+instance ApproxEq FieldName+instance ApproxEq CacheName+instance ApproxEq CacheKey+instance ApproxEq Existence+instance ApproxEq CutoffFrequency+instance ApproxEq Analyzer+instance ApproxEq Lenient+instance ApproxEq Tiebreaker+instance ApproxEq Boost+instance ApproxEq BoostTerms+instance ApproxEq MaxExpansions+instance ApproxEq MinimumMatch+instance ApproxEq DisableCoord+instance ApproxEq IgnoreTermFrequency+instance ApproxEq MinimumTermFrequency+instance ApproxEq MaxQueryTerms+instance ApproxEq Fuzziness+instance ApproxEq PrefixLength+instance ApproxEq TypeName+instance ApproxEq PercentMatch+instance ApproxEq StopWord+instance ApproxEq QueryPath+instance ApproxEq AllowLeadingWildcard+instance ApproxEq LowercaseExpanded+instance ApproxEq EnablePositionIncrements+instance ApproxEq AnalyzeWildcard+instance ApproxEq GeneratePhraseQueries+instance ApproxEq Locale+instance ApproxEq MaxWordLength+instance ApproxEq MinWordLength+instance ApproxEq PhraseSlop+instance ApproxEq MinDocFrequency+instance ApproxEq MaxDocFrequency+instance ApproxEq Filter+instance ApproxEq Query+instance ApproxEq SimpleQueryStringQuery+instance ApproxEq FieldOrFields+instance ApproxEq SimpleQueryFlag+instance ApproxEq RegexpQuery+instance ApproxEq QueryStringQuery+instance ApproxEq RangeQuery+instance ApproxEq PrefixQuery+instance ApproxEq NestedQuery+instance ApproxEq MoreLikeThisFieldQuery+instance ApproxEq MoreLikeThisQuery+instance ApproxEq IndicesQuery+instance ApproxEq HasParentQuery+instance ApproxEq HasChildQuery+instance ApproxEq FuzzyQuery+instance ApproxEq FuzzyLikeFieldQuery+instance ApproxEq FuzzyLikeThisQuery+instance ApproxEq FilteredQuery+instance ApproxEq DisMaxQuery+instance ApproxEq CommonTermsQuery+instance ApproxEq CommonMinimumMatch+instance ApproxEq BoostingQuery+instance ApproxEq BoolQuery+instance ApproxEq MatchQuery+instance ApproxEq MultiMatchQueryType+instance ApproxEq BooleanOperator+instance ApproxEq ZeroTermsQuery+instance ApproxEq MatchQueryType+instance ApproxEq AliasRouting+instance ApproxEq IndexAliasCreate+instance ApproxEq SearchAliasRouting+instance ApproxEq ScoreType+instance ApproxEq Distance+instance ApproxEq DistanceUnit+instance ApproxEq DistanceType+instance ApproxEq OptimizeBbox+instance ApproxEq GeoBoundingBoxConstraint+instance ApproxEq GeoFilterType+instance ApproxEq GeoBoundingBox+instance ApproxEq LatLon+instance ApproxEq RangeExecution+instance ApproxEq FSType+instance ApproxEq CompoundFormat+instance ApproxEq InitialShardCount+instance ApproxEq Bytes+instance ApproxEq ReplicaBounds+instance ApproxEq Term+instance ApproxEq BoolMatch+instance ApproxEq MultiMatchQuery+instance ApproxEq IndexSettings+instance ApproxEq AllocationPolicy+instance ApproxEq Char where+  (=~) = (==)+instance ApproxEq Vers.Version where+  (=~) = (==)+instance (ApproxEq a, Show a) => ApproxEq [a] where+  as =~ bs = and (zipWith (=~) as bs)+instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where+  Left a =~ Left b = a =~ b+  Right a =~ Right b = a =~ b+  _ =~ _ = False+  showApproxEq (Left x)  = "Left " <> showApproxEq x+  showApproxEq (Right x) = "Right " <> showApproxEq x+instance ApproxEq NodeAttrFilter+instance ApproxEq NodeAttrName+instance ApproxEq BuildHash+instance ApproxEq TemplateQueryKeyValuePairs where +  (=~) = (==)+instance ApproxEq TemplateQueryInline+instance ApproxEq Size+instance ApproxEq PhraseSuggesterHighlighter+instance ApproxEq PhraseSuggesterCollate+instance ApproxEq PhraseSuggester+instance ApproxEq SuggestType+instance ApproxEq Suggest++-- | Due to the way nodeattrfilters get serialized here, they may come+-- out in a different order, but they are morally equivalent+instance ApproxEq UpdatableIndexSetting where+  RoutingAllocationInclude a =~ RoutingAllocationInclude b =+    NE.sort a =~ NE.sort b+  RoutingAllocationExclude a =~ RoutingAllocationExclude b =+    NE.sort a =~ NE.sort b+  RoutingAllocationRequire a =~ RoutingAllocationRequire b =+    NE.sort a =~ NE.sort b+  a =~ b = a == b+  showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))+  showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))+  showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))+  showApproxEq x = show x+++noDuplicates :: Eq a => [a] -> Bool+noDuplicates xs = nub xs == xs++instance Arbitrary NominalDiffTime where+  arbitrary = fromInteger <$> arbitrary++#if !MIN_VERSION_QuickCheck(2,8,0)+instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where+  arbitrary = M.fromList <$> arbitrary+#endif++instance Arbitrary Text where+  arbitrary = T.pack <$> arbitrary++instance Arbitrary UTCTime where+  arbitrary = UTCTime+          <$> arbitrary+          <*> (fromRational . toRational <$> choose (0::Double, 86400))++instance Arbitrary Day where+    arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary+    shrink    = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay++#if !MIN_VERSION_QuickCheck(2,9,0)+instance Arbitrary a => Arbitrary (NonEmpty a) where+  arbitrary = liftA2 (:|) arbitrary arbitrary+#endif++arbitraryScore :: Gen Score+arbitraryScore = fmap getPositive <$> arbitrary++instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where+  arbitrary = Hit <$> arbitrary+                  <*> arbitrary+                  <*> arbitrary+                  <*> arbitraryScore+                  <*> arbitrary+                  <*> arbitrary+  shrink = genericShrink+++instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where+  arbitrary = reduceSize $ do+    tot <- getPositive <$> arbitrary+    score <- arbitraryScore+    hs <- arbitrary+    return $ SearchHits tot score hs+  shrink = genericShrink++reduceSize :: Gen a -> Gen a+reduceSize f = sized $ \n -> resize (n `div` 2) f++getSource :: EsResult a -> Maybe a+getSource = fmap _source . foundResult++grabFirst :: Either EsError (SearchResult a) -> Either EsError a+grabFirst r =+  case fmap (hitSource . head . hits . searchHits) r of+    (Left e)         -> Left e+    (Right Nothing)  -> Left (EsError 500 "Source was missing")+    (Right (Just x)) -> Right x++-------------------------------------------------------------------------------+arbitraryAlphaNum :: Gen Char+arbitraryAlphaNum = oneof [choose ('a', 'z')+                          ,choose ('A','Z')+                          , choose ('0', '9')]++instance Arbitrary RoutingValue where+  arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum++instance Arbitrary AliasRouting where+  arbitrary = oneof [allAlias+                    ,one+                    ,theOther+                    ,both]+    where one = GranularAliasRouting+                <$> (Just <$> arbitrary)+                <*> pure Nothing+          theOther = GranularAliasRouting Nothing+                     <$> (Just <$> arbitrary)+          both = GranularAliasRouting+                 <$> (Just <$> arbitrary)+                 <*> (Just <$> arbitrary)+          allAlias = AllAliasRouting <$> arbitrary+  shrink = genericShrink+++instance Arbitrary FieldName where+  arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum+  shrink = genericShrink+++instance Arbitrary RegexpFlags where+  arbitrary = oneof [ pure AllRegexpFlags+                    , pure NoRegexpFlags+                    , SomeRegexpFlags <$> genUniqueFlags+                    ]+    where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary+  shrink = genericShrink+++instance Arbitrary IndexAliasCreate where+  arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary+  shrink = genericShrink++instance Arbitrary Query where+  arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary+                                 , TermsQuery <$> arbitrary <*> arbitrary+                                 , QueryMatchQuery <$> arbitrary+                                 , QueryMultiMatchQuery <$> arbitrary+                                 , QueryBoolQuery <$> arbitrary+                                 , QueryBoostingQuery <$> arbitrary+                                 , QueryCommonTermsQuery <$> arbitrary+                                 , ConstantScoreFilter <$> arbitrary <*> arbitrary+                                 , ConstantScoreQuery <$> arbitrary <*> arbitrary+                                 , QueryDisMaxQuery <$> arbitrary+                                 , QueryFilteredQuery <$> arbitrary+                                 , QueryFuzzyLikeThisQuery <$> arbitrary+                                 , QueryFuzzyLikeFieldQuery <$> arbitrary+                                 , QueryFuzzyQuery <$> arbitrary+                                 , QueryHasChildQuery <$> arbitrary+                                 , QueryHasParentQuery <$> arbitrary+                                 , IdsQuery <$> arbitrary <*> arbitrary+                                 , QueryIndicesQuery <$> arbitrary+                                 , MatchAllQuery <$> arbitrary+                                 , QueryMoreLikeThisQuery <$> arbitrary+                                 , QueryMoreLikeThisFieldQuery <$> arbitrary+                                 , QueryNestedQuery <$> arbitrary+                                 , QueryPrefixQuery <$> arbitrary+                                 , QueryQueryStringQuery <$> arbitrary+                                 , QuerySimpleQueryStringQuery <$> arbitrary+                                 , QueryRangeQuery <$> arbitrary+                                 , QueryRegexpQuery <$> arbitrary+                                 , QueryTemplateQueryInline <$> arbitrary+                                 ]+  shrink = genericShrink++instance Arbitrary Filter where+  arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary+                                 , OrFilter <$> arbitrary <*> arbitrary+                                 , NotFilter <$> arbitrary <*> arbitrary+                                 , pure IdentityFilter+                                 , BoolFilter <$> arbitrary+                                 , ExistsFilter <$> arbitrary+                                 , GeoBoundingBoxFilter <$> arbitrary+                                 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+                                 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary+                                 , GeoPolygonFilter <$> arbitrary <*> arbitrary+                                 , IdsFilter <$> arbitrary <*> arbitrary+                                 , LimitFilter <$> arbitrary+                                 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary+                                 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary+                                 , QueryFilter <$> arbitrary <*> arbitrary+                                 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+                                 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+                                 , TermFilter <$> arbitrary <*> arbitrary]+  shrink = genericShrink++instance Arbitrary ReplicaBounds where+  arbitrary = oneof [ replicasBounded+                    , replicasLowerBounded+                    , pure ReplicasUnbounded+                    ]+    where replicasBounded = do Positive a <- arbitrary+                               Positive b <- arbitrary+                               return (ReplicasBounded a b)+          replicasLowerBounded = do Positive a <- arbitrary+                                    return (ReplicasLowerBounded a)++instance Arbitrary NodeAttrName where+  arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum+++instance Arbitrary NodeAttrFilter where+  arbitrary = do+    n <- arbitrary+    s:ss <- listOf1 (listOf1 arbitraryAlphaNum)+    let ts = T.pack <$> s :| ss+    return (NodeAttrFilter n ts)+  shrink = genericShrink++instance Arbitrary VersionNumber where+  arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary+    where+      mk versions = VersionNumber (Vers.Version versions [])++instance Arbitrary TemplateQueryKeyValuePairs where+  arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary+  shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x++instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GeoPoint where+  arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary+    where+      -- These are problematic for geopoint for obvious reasons+      reasonableFieldName (FieldName "from") = False+      reasonableFieldName (FieldName "to") = False+      reasonableFieldName _ = True+  shrink = genericShrink+instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink++newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting+                               deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)++instance Arbitrary UpdatableIndexSetting' where+  arbitrary = do+    settings <- arbitrary+    return $ UpdatableIndexSetting' $ case settings of+      RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)+      RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)+      RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)+      x -> x+    where+      dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList+      sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b++main :: IO ()+main = hspec $ do++  describe "index create/delete API" $ do+    it "creates and then deletes the requested index" $ withTestEnv $ do+      -- priming state.+      _ <- deleteExampleIndex+      resp <- createExampleIndex+      deleteResp <- deleteExampleIndex+      liftIO $ do+        validateStatus resp 200+        validateStatus deleteResp 200++  describe "error parsing"  $ do+    it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do+      res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")+      let errorResp = eitherDecode (responseBody res)+      liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))++    it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do+      res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")+      let errorResp = eitherDecode (responseBody res)+      liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))++  describe "document API" $ do+    it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do+      _ <- insertData+      _ <- updateData+      docInserted <- getDocument testIndex testMapping (DocId "1")+      let newTweet = eitherDecode+                     (responseBody docInserted) :: Either String (EsResult Tweet)+      liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))++    it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do+      _ <- insertWithSpaceInId+      docInserted <- getDocument testIndex testMapping (DocId "Hello World")+      let newTweet = eitherDecode+                     (responseBody docInserted) :: Either String (EsResult Tweet)+      liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))++    it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do+      doc <- getDocument testIndex testMapping  (DocId "bogus")+      let noTweet = eitherDecode+                    (responseBody doc) :: Either String (EsResult Tweet)+      liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing++    it "can use optimistic concurrency control" $ withTestEnv $ do+      let ev = ExternalDocVersion minBound+      let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }+      resetIndex+      res <- insertData' cfg+      liftIO $ isCreated res `shouldBe` True+      res' <- insertData' cfg+      liftIO $ isVersionConflict res' `shouldBe` True++    it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do+      resetIndex+      _ <- putMapping testIndex (MappingName "child") ChildMapping+      _ <- putMapping testIndex (MappingName "parent") ParentMapping+      _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")+      let parent = (Just . DocumentParent . DocId) "1"+          ids = IndexDocumentSettings NoVersionControl parent+      _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")+      _ <- refreshIndex testIndex+      exists <- documentExists testIndex (MappingName "child") parent (DocId "2")+      liftIO $ exists `shouldBe` True++  describe "template API" $ do+    it "can create a template" $ withTestEnv $ do+      let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]+      resp <- putTemplate idxTpl (TemplateName "tweet-tpl")+      liftIO $ validateStatus resp 200++    it "can detect if a template exists" $ withTestEnv $ do+      exists <- templateExists (TemplateName "tweet-tpl")+      liftIO $ exists `shouldBe` True++    it "can delete a template" $ withTestEnv $ do+      resp <- deleteTemplate (TemplateName "tweet-tpl")+      liftIO $ validateStatus resp 200++    it "can detect if a template doesn't exist" $ withTestEnv $ do+      exists <- templateExists (TemplateName "tweet-tpl")+      liftIO $ exists `shouldBe` False++  describe "bulk API" $ do+    it "inserts all documents we request" $ withTestEnv $ do+      _ <- insertData+      let firstTest = BulkTest "blah"+      let secondTest = BulkTest "bloo"+      let firstDoc = BulkIndex testIndex+                     testMapping (DocId "2") (toJSON firstTest)+      let secondDoc = BulkCreate testIndex+                     testMapping (DocId "3") (toJSON secondTest)+      let stream = V.fromList [firstDoc, secondDoc]+      _ <- bulk stream+      _ <- refreshIndex testIndex+      fDoc <- getDocument testIndex testMapping (DocId "2")+      sDoc <- getDocument testIndex testMapping (DocId "3")+      let maybeFirst  = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)+      let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)+      liftIO $ do+        fmap getSource maybeFirst `shouldBe` Right (Just firstTest)+        fmap getSource maybeSecond `shouldBe` Right (Just secondTest)+++  describe "query API" $ do+    it "returns document for term query and identity filter" $ withTestEnv $ do+      _ <- insertData+      let query = TermQuery (Term "user" "bitemyapp") Nothing+      let filter = IdentityFilter <&&> IdentityFilter+      let search = mkSearch (Just query) (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "handles constant score queries" $ withTestEnv $ do+      _ <- insertData+      let query = TermsQuery "user" ("bitemyapp" :| [])+      let cfQuery = ConstantScoreQuery query (Boost 1.0)+      let filter = IdentityFilter+      let search = mkSearch (Just cfQuery) (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet+    it "handles constant score filters" $ withTestEnv $ do+      _ <- insertData+      let query = TermsQuery "user" ("bitemyapp" :| [])+      let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)+      let boolQuery = mkBoolQuery [query, cfFilter] [] []+      let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet+++    it "returns document for terms query and identity filter" $ withTestEnv $ do+      _ <- insertData+      let query = TermsQuery "user" ("bitemyapp" :| [])+      let filter = IdentityFilter <&&> IdentityFilter+      let search = mkSearch (Just query) (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for match query" $ withTestEnv $ do+      _ <- insertData+      let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+      let search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for multi-match query" $ withTestEnv $ do+      _ <- insertData+      let flds = [FieldName "user", FieldName "message"]+      let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")+      let search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do+      _ <- insertData+      let tiebreaker = Just $ Tiebreaker 0.3+          flds = [FieldName "user", FieldName "message"]+          multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")+          query =  QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }+          search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for bool query" $ withTestEnv $ do+      _ <- insertData+      let innerQuery = QueryMatchQuery $+                       mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+      let query = QueryBoolQuery $+                  mkBoolQuery [innerQuery] [] []+      let search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for boosting query" $ withTestEnv $ do+      _ <- insertData+      let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")+      let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")+      let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)+      let search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for common terms query" $ withTestEnv $ do+      _ <- insertData+      let query = QueryCommonTermsQuery $+                  CommonTermsQuery (FieldName "user")+                  (QueryString "bitemyapp")+                  (CutoffFrequency 0.0001)+                  Or Or Nothing Nothing Nothing Nothing+      let search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for for inline template query" $ withTestEnv $ do+      _ <- insertData+      let innerQuery = QueryMatchQuery $+                         mkMatchQuery (FieldName "{{userKey}}")+                                      (QueryString "{{bitemyappKey}}")+          templateParams = TemplateQueryKeyValuePairs $ HM.fromList+                            [ ("userKey", "user")+                            , ("bitemyappKey", "bitemyapp")+                            ]+          templateQuery = QueryTemplateQueryInline $+                            TemplateQueryInline innerQuery templateParams+          search = mkSearch (Just templateQuery) Nothing+      myTweet <- searchTweet search+      liftIO $ myTweet `shouldBe` Right exampleTweet+++  describe "sorting" $ do+    it "returns documents in the right order" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending+      let search = Search Nothing+                   (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing+                   False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+                   Nothing+      result <- searchTweets search+      let myTweet = grabFirst result+      liftIO $+        myTweet `shouldBe` Right otherTweet+++  describe "filtering API" $ do+    it "returns document for composed boolmatch and identity" $ withTestEnv $ do+      _ <- insertData+      let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)+                        <&&> IdentityFilter+      let search = mkSearch Nothing (Just queryFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for term filter" $ withTestEnv $ do+      _ <- insertData+      let termFilter = TermFilter (Term "user" "bitemyapp") False+      let search = mkSearch Nothing (Just termFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for existential filter" $ withTestEnv $ do+      _ <- insertData+      let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for geo boundingbox filter" $ withTestEnv $ do+      _ <- insertData+      let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))+      let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory+      let geoFilter = GeoBoundingBoxFilter bbConstraint+      let search = mkSearch Nothing (Just geoFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do+      _ <- insertData+      let box          = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))+      let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory+      let geoFilter    = GeoBoundingBoxFilter bbConstraint+      let search       = mkSearch Nothing (Just geoFilter)+      searchExpectNoResults search++    it "returns document for geo distance filter" $ withTestEnv $ do+      _ <- insertData+      let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+      let distance = Distance 10.0 Miles+      let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory+      let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False+      let search = mkSearch Nothing (Just geoFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for geo distance range filter" $ withTestEnv $ do+      _ <- insertData+      let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+      let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)+      let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange+      let search = mkSearch Nothing (Just geoFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do+      _ <- insertData+      let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))+      let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)+      let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange+      let search = mkSearch Nothing (Just geoFilter)+      searchExpectNoResults search++    it "returns document for geo polygon filter" $ withTestEnv $ do+      _ <- insertData+      let points = [LatLon 40.0 (-70.00),+                    LatLon 40.0 (-72.00),+                    LatLon 41.0 (-70.00),+                    LatLon 41.0 (-72.00)]+      let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points+      let search = mkSearch Nothing (Just geoFilter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do+      _ <- insertData+      let points = [LatLon 40.0 (-70.00),+                    LatLon 40.0 (-71.00),+                    LatLon 41.0 (-70.00),+                    LatLon 41.0 (-71.00)]+      let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points+      let search = mkSearch Nothing (Just geoFilter)+      searchExpectNoResults search++    it "returns document for ids filter" $ withTestEnv $ do+      _ <- insertData+      let filter = IdsFilter (MappingName "tweet") [DocId "1"]+      let search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for Double range filter" $ withTestEnv $ do+      _ <- insertData+      let filter = RangeFilter (FieldName "age")+                   (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))+                   RangeExecutionIndex False+      let search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for UTCTime date filter" $ withTestEnv $ do+      _ <- insertData+      let filter = RangeFilter (FieldName "postDate")+                   (RangeDateGtLt+                    (GreaterThanD (UTCTime+                                (ModifiedJulianDay 54000)+                                (secondsToDiffTime 0)))+                    (LessThanD (UTCTime+                                (ModifiedJulianDay 55000)+                                (secondsToDiffTime 11))))+                   RangeExecutionIndex False+      let search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "returns document for regexp filter" $ withTestEnv $ do+      _ <- insertData+      let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")+                   AllRegexpFlags (CacheName "test") False (CacheKey "key")+      let search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet++    it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do+      _ <- insertData+      let filter = RegexpFilter (FieldName "user")+                   (Regexp "boy") AllRegexpFlags+                   (CacheName "test") False (CacheKey "key")+      let search = mkSearch Nothing (Just filter)+      searchExpectNoResults search++    it "returns document for query filter, uncached" $ withTestEnv $ do+      _ <- insertData+      let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True+          search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $ myTweet `shouldBe` Right exampleTweet++    it "returns document for query filter, cached" $ withTestEnv $ do+      _ <- insertData+      let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False+          search = mkSearch Nothing (Just filter)+      myTweet <- searchTweet search+      liftIO $ myTweet `shouldBe` Right exampleTweet++  describe "Aggregation API" $ do+    it "returns term aggregation results" $ withTestEnv $ do+      _ <- insertData+      let terms = TermsAgg $ mkTermsAggregation "user"+      let search = mkAggregateSearch Nothing $ mkAggregations "users" terms+      searchExpectAggs search+      searchValidBucketAgg search "users" toTerms++    it "return sub-aggregation results" $ withTestEnv $ do+      _ <- insertData+      let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"+          agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}+          search = mkAggregateSearch Nothing $ mkAggregations "users" agg+      reply <- searchByIndex testIndex search+      let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)+          usersAggResults = result >>= aggregations >>= toTerms "users"+          subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"+          subAddResultsExists = isJust subAggResults+      liftIO $ (subAddResultsExists) `shouldBe` True++    it "returns cardinality aggregation results" $ withTestEnv $ do+      _ <- insertData+      let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"+      let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality+      let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }+      searchExpectAggs search'+      let docCountPair k n = (k, object ["value" .= Number n])+      res <- searchTweets search'+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))++    it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do+      _ <- insertData+      let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }+      let search = mkAggregateSearch Nothing $ mkAggregations "users" terms+      searchExpectAggs search+      searchValidBucketAgg search "users" toTerms++    -- One of these fails with 1.7.3+    it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do+      _ <- insertData+      searchTermsAggHint [Map, Ordinals]++    it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do+      _ <- insertData+      searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]++    it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do+      _ <- insertData+      searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]+    -- One of the above.++    it "can execute value_count aggregations" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>+                mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))+      let search = mkAggregateSearch Nothing ags+      let docCountPair k n = (k, object ["value" .= Number n])+      res <- searchTweets search+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2+                                                                 , docCountPair "bogus_count" 0+                                                                 ]))++    it "can execute filter aggregations" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>+                mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))+      let search = mkAggregateSearch Nothing ags+      let docCountPair k n = (k, object ["doc_count" .= Number n])+      res <- searchTweets search+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1+                                                                 , docCountPair "notmyapps" 1+                                                                 ]))+    it "can execute date_range aggregations" $ withTestEnv $ do+      let now = fromGregorian 2015 3 14+      let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0+      let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0+      let oldDoc = exampleTweet { postDate = ltAMonthAgo }+      let newDoc = exampleTweet { postDate = ltAWeekAgo }+      _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")+      _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")+      _ <- refreshIndex testIndex+      let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])+      let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])+      let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])+      let ags = mkAggregations "date_ranges" (DateRangeAgg agg)+      let search = mkAggregateSearch Nothing ags+      res <- searchTweets search+      liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2+      let bucks = do magrs <- fmapL show (aggregations <$> res)+                     agrs <- note "no aggregations returned" magrs+                     rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs+                     parseEither parseJSON rawBucks+      let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0+      let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0+      liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"+                                                                    (Just fromMonthT)+                                                                    (Just "2015-02-14T00:00:00.000Z")+                                                                    Nothing+                                                                    Nothing+                                                                    2+                                                                    Nothing+                                                  , DateRangeResult "2015-03-07T00:00:00.000Z-*"+                                                                    (Just fromWeekT)+                                                                    (Just "2015-03-07T00:00:00.000Z")+                                                                    Nothing+                                                                    Nothing+                                                                    1+                                                                    Nothing+                                     ]++    it "returns date histogram aggregation results" $ withTestEnv $ do+      _ <- insertData+      let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute+      let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)+      searchExpectAggs search+      searchValidBucketAgg search "byDate" toDateHistogram++    it "returns date histogram using fractional date" $ withTestEnv $ do+      _ <- insertData+      let periods            = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]+      let fractionals        = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]+      let intervals          = periods ++ fractionals+      let histogram          = mkDateHistogram (FieldName "postDate")+      let search interval    = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)+      let expect interval    = searchExpectAggs (search interval)+      let valid interval     = searchValidBucketAgg (search interval) "byDate" toDateHistogram+      forM_ intervals expect+      forM_ intervals valid++    it "can execute missing aggregations" $ withTestEnv $ do+      _ <- insertData+      _ <- insertExtra+      let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))+      let search = mkAggregateSearch Nothing ags+      let docCountPair k n = (k, object ["doc_count" .= Number n])+      res <- searchTweets search+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))++  describe "Highlights API" $ do++    it "returns highlight from query when there should be one" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")+      let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]++      let search = mkHighlightSearch (Just query) testHighlight+      myHighlight <- searchTweetHighlight search+      liftIO $+        myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))++    it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")+      let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]++      let search = mkHighlightSearch (Just query) testHighlight+      myHighlight <- searchTweetHighlight search+      liftIO $+        myHighlight `shouldBe` Right Nothing++  describe "Source filtering" $ do++    it "doesn't include source when sources are disabled" $ withTestEnv $ do+      searchExpectSource+        NoSource+        (Left (EsError 500 "Source was missing"))++    it "includes a source" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPattern (Pattern "message")))+        (Right (Object (HM.fromList [("message", String "Use haskell!")])))++    it "includes sources" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))+        (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))++    it "includes source patterns" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPattern (Pattern "*ge")))+        (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))++    it "excludes source patterns" $ withTestEnv $ do+      searchExpectSource+        (SourceIncludeExclude (Include [])+        (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))+        (Right (Object (HM.fromList [("user",String "bitemyapp")])))++  describe "ToJSON RegexpFlags" $ do+    it "generates the correct JSON for AllRegexpFlags" $+      toJSON AllRegexpFlags `shouldBe` String "ALL"++    it "generates the correct JSON for NoRegexpFlags" $+      toJSON NoRegexpFlags `shouldBe` String "NONE"++    it "generates the correct JSON for SomeRegexpFlags" $+      let flags = AnyString :| [ Automaton+                               , Complement+                               , Empty+                               , Intersection+                               , Interval ]+      in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"++    prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->+      let String str = toJSON flags+          flagStrs   = T.splitOn "|" str+      in noDuplicates flagStrs++  describe "omitNulls" $ do+    it "checks that omitNulls drops list elements when it should" $+       let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))+                                 , "test2" .= (toJSON ("some value" :: Text))]+       in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])++    it "checks that omitNulls doesn't drop list elements when it shouldn't" $+       let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))+                                    , "test2" .= (toJSON ("some value" :: Text))]+       in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))+                                                 , ("test2", String "some value")])+    it "checks that omitNulls drops non list elements when it should" $+       let dropped = omitNulls $ [ "test1" .= (toJSON Null)+                                 , "test2" .= (toJSON ("some value" :: Text))]+       in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])+    it "checks that omitNulls doesn't drop non list elements when it shouldn't" $+       let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))+                                    , "test2" .= (toJSON ("some value" :: Text))]+       in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)+                                                   , ("test2", String "some value")])+  describe "Monoid (SearchHits a)" $ do+    prop "abides the monoid laws" $ eq $+      prop_Monoid (T :: T (SearchHits ()))++  describe "mkDocVersion" $ do+    prop "can never construct an out of range docVersion" $ \i ->+      let res = mkDocVersion i+      in case res of+        Nothing -> property True+        Just dv -> (dv >= minBound) .&&.+                   (dv <= maxBound) .&&.+                   docVersionNumber dv === i++  describe "FsSnapshotRepo" $ do+    prop "SnapshotRepo laws" $ \fsr ->+      fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)++  describe "snapshot repos" $ do+    it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do+      res <- getSnapshotRepos AllSnapshotRepos+      liftIO $ case res of+        Left e -> expectationFailure ("Expected a right but got Left " <> show e)+        Right _ -> return ()++    it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      let r2n = SnapshotRepoName "bloodhound-repo2"+      withSnapshotRepo r1n $ \r1 ->+        withSnapshotRepo r2n $ \r2 -> do+          repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))+          liftIO $ case repos of+            Right xs -> do+              let srt = L.sortBy (comparing gSnapshotRepoName)+              srt xs `shouldBe` srt [r1, r2]+            Left e -> expectationFailure (show e)++    it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \r1 -> do+        let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))+        let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing+        resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression+        liftIO (validateStatus resp 200)+        Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))+        liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)++    -- verify came around in 1.4 it seems+    it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \_ -> do+        res <- verifySnapshotRepo r1n+        liftIO $ case res of+          Right (SnapshotVerification vs)+            | null vs -> expectationFailure "Expected nonempty set of verifying nodes"+            | otherwise -> return ()+          Left e -> expectationFailure (show e)++  describe "snapshots" $ do+    it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \_ -> do+        res <- getSnapshots r1n AllSnapshots+        liftIO $ case res of+          Left e -> expectationFailure ("Expected a right but got Left " <> show e)+          Right _ -> return ()++    it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \_ -> do+        let s1n = SnapshotName "example-snapshot"+        withSnapshot r1n s1n $ do+          res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))+          liftIO $ case res of+            Right [snap]+              | snapInfoState snap == SnapshotSuccess &&+                snapInfoName snap == s1n -> return ()+              | otherwise -> expectationFailure (show snap)+            Right [] -> expectationFailure "There were no snapshots"+            Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))+            Left e -> expectationFailure (show e)++  describe "snapshot restore" $ do+    it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \_ -> do+        let s1n = SnapshotName "example-snapshot"+        withSnapshot r1n s1n $ do+          let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }+          -- have to close an index to restore it+          resp1 <- closeIndex testIndex+          liftIO (validateStatus resp1 200)+          resp2 <- restoreSnapshot r1n s1n settings+          liftIO (validateStatus resp2 200)++    it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do+      let r1n = SnapshotRepoName "bloodhound-repo1"+      withSnapshotRepo r1n $ \_ -> do+        let s1n = SnapshotName "example-snapshot"+        withSnapshot r1n s1n $ do+          let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"+          let replace = RRTLit "restored-" :| [RRSubWholeMatch]+          let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"+          oldEnoughForOverrides <- liftIO (atleast es15)+          let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }+          let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True+                                                        , snapRestoreRenamePattern = Just pat+                                                        , snapRestoreRenameReplacement = Just replace+                                                        , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides+                                                                                              then Just overrides+                                                                                              else Nothing+                                                        }+          -- have to close an index to restore it+          let go = do+                resp <- restoreSnapshot r1n s1n settings+                liftIO (validateStatus resp 200)+                exists <- indexExists expectedIndex+                liftIO (exists `shouldBe` True)+          go `finally` deleteIndex expectedIndex++  describe "getNodesInfo" $ do+     it "fetches the responding node when LocalNode is used" $ withTestEnv $ do+       res <- getNodesInfo LocalNode+       liftIO $ case res of+         -- This is really just a smoke test for response+         -- parsing. Node info is so variable, there's not much I can+         -- assert here.+         Right NodesInfo {..} -> length nodesInfo `shouldBe` 1+         Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)++  describe "getNodesStats" $ do+     it "fetches the responding node when LocalNode is used" $ withTestEnv $ do+       res <- getNodesStats LocalNode+       liftIO $ case res of+         -- This is really just a smoke test for response+         -- parsing. Node stats is so variable, there's not much I can+         -- assert here.+         Right NodesStats {..} -> length nodesStats `shouldBe` 1+         Left e -> expectationFailure ("Expected NodesStats but got " <> show e)++  describe "Enum DocVersion" $ do+    it "follows the laws of Enum, Bounded" $ do+      evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall+      evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall+      evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall+      evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall+      enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]+      enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]+      enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]++  describe "scan&scroll API" $ do+    it "returns documents using the scan&scroll API" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }+      regular_search <- searchTweet search+      scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]+      let scan_search = map hitSource scan_search'+      liftIO $+        regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored+      liftIO $+        scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]++  describe "index aliases" $ do+    it "handles the simple case of aliasing an existing index" $ do+      let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))+      let create = IndexAliasCreate Nothing Nothing+      let action = AddAlias alias create++      withTestEnv $ do+        resetIndex+        resp <- updateIndexAliases (action :| [])+        liftIO $ validateStatus resp 200+      let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))+      (do aliases <- withTestEnv getIndexAliases+          let expected = IndexAliasSummary alias create+          case aliases of+            Right (IndexAliasesSummary summs) ->+              L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected+            Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup++    it "handles an alias with routing and a filter" $ do+      let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))+      let sar = SearchAliasRouting (RoutingValue "search val" :| [])+      let iar = IndexAliasRouting (RoutingValue "index val")+      let routing = GranularAliasRouting (Just sar) (Just iar)+      let filter = LimitFilter 42+      let create = IndexAliasCreate (Just routing) (Just filter)+      let action = AddAlias alias create++      withTestEnv $ do+        resetIndex+        resp <- updateIndexAliases (action :| [])+        liftIO $ validateStatus resp 200+      let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))+      (do aliases <- withTestEnv getIndexAliases+          let expected = IndexAliasSummary alias create+          case aliases of+            Right (IndexAliasesSummary summs) ->+              L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected+            Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup++  describe "Index Listing" $ do+    it "returns a list of index names" $ withTestEnv $ do+      _ <- createExampleIndex+      ixns <- listIndices+      liftIO (ixns `shouldContain` [testIndex])++  describe "Index Settings" $ do+    it "persists settings" $ withTestEnv $ do+      _ <- deleteExampleIndex+      _ <- createExampleIndex+      let updates = BlocksWrite False :| []+      updateResp <- updateIndexSettings updates testIndex+      liftIO $ validateStatus updateResp 200+      getResp <- getIndexSettings testIndex+      liftIO $+        getResp `shouldBe` Right (IndexSettingsSummary+                                    testIndex+                                    (IndexSettings (ShardCount 1) (ReplicaCount 0))+                                    (NE.toList updates))++  describe "Index Optimization" $ do+    it "returns a successful response upon completion" $ withTestEnv $ do+      _ <- createExampleIndex+      resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings+      liftIO $ validateStatus resp 200++  describe "Suggest" $ do+    it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do+      _ <- insertData+      let {- query = QueryMatchNoneQuery+          query = TermQuery (Term "user" "bitemyapp") Nothing -}+      let phraseSuggester = mkPhraseSuggester (FieldName "message")+          namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)+          search' = mkSearch Nothing Nothing+          search = search' { suggestBody = Just namedSuggester }+          expectedText = Just "use haskell"+      resp <- searchByIndex testIndex search+      parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))+      case parsed of+        Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)+        Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses  <$> suggest sr) `shouldBe` expectedText++  describe "JSON instances" $ do+    propJSON (Proxy :: Proxy Version)+    propJSON (Proxy :: Proxy IndexName)+    propJSON (Proxy :: Proxy MappingName)+    propJSON (Proxy :: Proxy DocId)+    propJSON (Proxy :: Proxy IndexAliasRouting)+    propJSON (Proxy :: Proxy RoutingValue)+    propJSON (Proxy :: Proxy ShardCount)+    propJSON (Proxy :: Proxy ReplicaCount)+    propJSON (Proxy :: Proxy TemplateName)+    propJSON (Proxy :: Proxy TemplatePattern)+    propJSON (Proxy :: Proxy QueryString)+    propJSON (Proxy :: Proxy FieldName)+    propJSON (Proxy :: Proxy CacheName)+    propJSON (Proxy :: Proxy CacheKey)+    propJSON (Proxy :: Proxy Existence)+    propJSON (Proxy :: Proxy CutoffFrequency)+    propJSON (Proxy :: Proxy Analyzer)+    propJSON (Proxy :: Proxy MaxExpansions)+    propJSON (Proxy :: Proxy Lenient)+    propJSON (Proxy :: Proxy Tiebreaker)+    propJSON (Proxy :: Proxy Boost)+    propJSON (Proxy :: Proxy BoostTerms)+    propJSON (Proxy :: Proxy MinimumMatch)+    propJSON (Proxy :: Proxy DisableCoord)+    propJSON (Proxy :: Proxy IgnoreTermFrequency)+    propJSON (Proxy :: Proxy MinimumTermFrequency)+    propJSON (Proxy :: Proxy MaxQueryTerms)+    propJSON (Proxy :: Proxy Fuzziness)+    propJSON (Proxy :: Proxy PrefixLength)+    propJSON (Proxy :: Proxy TypeName)+    propJSON (Proxy :: Proxy PercentMatch)+    propJSON (Proxy :: Proxy StopWord)+    propJSON (Proxy :: Proxy QueryPath)+    propJSON (Proxy :: Proxy AllowLeadingWildcard)+    propJSON (Proxy :: Proxy LowercaseExpanded)+    propJSON (Proxy :: Proxy EnablePositionIncrements)+    propJSON (Proxy :: Proxy AnalyzeWildcard)+    propJSON (Proxy :: Proxy GeneratePhraseQueries)+    propJSON (Proxy :: Proxy Locale)+    propJSON (Proxy :: Proxy MaxWordLength)+    propJSON (Proxy :: Proxy MinWordLength)+    propJSON (Proxy :: Proxy PhraseSlop)+    propJSON (Proxy :: Proxy MinDocFrequency)+    propJSON (Proxy :: Proxy MaxDocFrequency)+    propJSON (Proxy :: Proxy Filter)+    propJSON (Proxy :: Proxy Query)+    propJSON (Proxy :: Proxy SimpleQueryStringQuery)+    propJSON (Proxy :: Proxy FieldOrFields)+    propJSON (Proxy :: Proxy SimpleQueryFlag)+    propJSON (Proxy :: Proxy RegexpQuery)+    propJSON (Proxy :: Proxy QueryStringQuery)+    propJSON (Proxy :: Proxy RangeQuery)+    propJSON (Proxy :: Proxy PrefixQuery)+    propJSON (Proxy :: Proxy NestedQuery)+    propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)+    propJSON (Proxy :: Proxy MoreLikeThisQuery)+    propJSON (Proxy :: Proxy IndicesQuery)+    propJSON (Proxy :: Proxy HasParentQuery)+    propJSON (Proxy :: Proxy HasChildQuery)+    propJSON (Proxy :: Proxy FuzzyQuery)+    propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)+    propJSON (Proxy :: Proxy FuzzyLikeThisQuery)+    propJSON (Proxy :: Proxy FilteredQuery)+    propJSON (Proxy :: Proxy DisMaxQuery)+    propJSON (Proxy :: Proxy CommonTermsQuery)+    propJSON (Proxy :: Proxy CommonMinimumMatch)+    propJSON (Proxy :: Proxy BoostingQuery)+    propJSON (Proxy :: Proxy BoolQuery)+    propJSON (Proxy :: Proxy MatchQuery)+    propJSON (Proxy :: Proxy MultiMatchQueryType)+    propJSON (Proxy :: Proxy BooleanOperator)+    propJSON (Proxy :: Proxy ZeroTermsQuery)+    propJSON (Proxy :: Proxy MatchQueryType)+    propJSON (Proxy :: Proxy AliasRouting)+    propJSON (Proxy :: Proxy IndexAliasCreate)+    propJSON (Proxy :: Proxy SearchAliasRouting)+    propJSON (Proxy :: Proxy ScoreType)+    propJSON (Proxy :: Proxy Distance)+    propJSON (Proxy :: Proxy DistanceUnit)+    propJSON (Proxy :: Proxy DistanceType)+    propJSON (Proxy :: Proxy OptimizeBbox)+    propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)+    propJSON (Proxy :: Proxy GeoFilterType)+    propJSON (Proxy :: Proxy GeoBoundingBox)+    propJSON (Proxy :: Proxy LatLon)+    propJSON (Proxy :: Proxy RangeExecution)+    prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->+      let expected = case rfs of+                       SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))+                       x -> x+      in parseEither parseJSON (toJSON rfs) === Right expected+    propJSON (Proxy :: Proxy BoolMatch)+    propJSON (Proxy :: Proxy Term)+    propJSON (Proxy :: Proxy MultiMatchQuery)+    propJSON (Proxy :: Proxy IndexSettings)+    propJSON (Proxy :: Proxy UpdatableIndexSetting')+    propJSON (Proxy :: Proxy ReplicaBounds)+    propJSON (Proxy :: Proxy Bytes)+    propJSON (Proxy :: Proxy AllocationPolicy)+    propJSON (Proxy :: Proxy InitialShardCount)+    propJSON (Proxy :: Proxy FSType)+    propJSON (Proxy :: Proxy CompoundFormat)+    propJSON (Proxy :: Proxy TemplateQueryInline)+    propJSON (Proxy :: Proxy Suggest)++-- Temporary solution for lacking of generic derivation of Arbitrary+-- We use generics-sop, as it's much more concise than directly using GHC.Generics+--+-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112+-- is merged and released+sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a+sopArbitrary = fmap SOP.gto sopArbitrary'++sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)+sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)+  where+    p :: Proxy Arbitrary+    p = Proxy

@@ -12,6 +12,9 @@ #if __GLASGOW_HASKELL__ < 800 {-# OPTIONS_GHC -fcontext-stack=100 #-} #endif+#if __GLASGOW_HASKELL__ >= 802+{-# LANGUAGE MonoLocalBinds #-}+#endif module Main where  import           Control.Applicative@@ -607,6 +610,15 @@ instance ApproxEq NodeAttrFilter instance ApproxEq NodeAttrName instance ApproxEq BuildHash+instance ApproxEq TemplateQueryKeyValuePairs where+  (=~) = (==)+instance ApproxEq TemplateQueryInline+instance ApproxEq Size+instance ApproxEq PhraseSuggesterHighlighter+instance ApproxEq PhraseSuggesterCollate+instance ApproxEq PhraseSuggester+instance ApproxEq SuggestType+instance ApproxEq Suggest  -- | Due to the way nodeattrfilters get serialized here, they may come -- out in a different order, but they are morally equivalent@@ -756,6 +768,7 @@                                  , QuerySimpleQueryStringQuery <$> arbitrary                                  , QueryRangeQuery <$> arbitrary                                  , QueryRegexpQuery <$> arbitrary+                                 , QueryTemplateQueryInline <$> arbitrary                                  ]   shrink = genericShrink @@ -791,6 +804,10 @@     where       mk versions = VersionNumber (Vers.Version versions []) +instance Arbitrary TemplateQueryKeyValuePairs where+  arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary+  shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x+ instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink@@ -898,6 +915,13 @@ instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink+instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink  newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting                                deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)@@ -1004,20 +1028,26 @@       _ <- insertData       let firstTest = BulkTest "blah"       let secondTest = BulkTest "bloo"+      let thirdTest = BulkTest "graffle"       let firstDoc = BulkIndex testIndex                      testMapping (DocId "2") (toJSON firstTest)       let secondDoc = BulkCreate testIndex                      testMapping (DocId "3") (toJSON secondTest)-      let stream = V.fromList [firstDoc, secondDoc]+      let thirdDoc = BulkCreateEncoding testIndex+                     testMapping (DocId "4") (toEncoding thirdTest)+      let stream = V.fromList [firstDoc, secondDoc, thirdDoc]       _ <- bulk stream       _ <- refreshIndex testIndex       fDoc <- getDocument testIndex testMapping (DocId "2")       sDoc <- getDocument testIndex testMapping (DocId "3")+      tDoc <- getDocument testIndex testMapping (DocId "4")       let maybeFirst  = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)       let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)+      let maybeThird = eitherDecode $ responseBody tDoc :: Either String (EsResult BulkTest)       liftIO $ do         fmap getSource maybeFirst `shouldBe` Right (Just firstTest)         fmap getSource maybeSecond `shouldBe` Right (Just secondTest)+        fmap getSource maybeThird `shouldBe` Right (Just thirdTest)     describe "query API" $ do@@ -1066,6 +1096,17 @@       liftIO $         myTweet `shouldBe` Right exampleTweet +    it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do+      _ <- insertData+      let tiebreaker = Just $ Tiebreaker 0.3+          flds = [FieldName "user", FieldName "message"]+          multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")+          query =  QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }+          search = mkSearch (Just query) Nothing+      myTweet <- searchTweet search+      liftIO $+        myTweet `shouldBe` Right exampleTweet+     it "returns document for bool query" $ withTestEnv $ do       _ <- insertData       let innerQuery = QueryMatchQuery $@@ -1099,7 +1140,22 @@       liftIO $         myTweet `shouldBe` Right exampleTweet +    it "returns document for for inline template query" $ withTestEnv $ do+      _ <- insertData+      let innerQuery = QueryMatchQuery $+                         mkMatchQuery (FieldName "{{userKey}}")+                                      (QueryString "{{bitemyappKey}}")+          templateParams = TemplateQueryKeyValuePairs $ HM.fromList+                            [ ("userKey", "user")+                            , ("bitemyappKey", "bitemyapp")+                            ]+          templateQuery = QueryTemplateQueryInline $+                            TemplateQueryInline innerQuery templateParams+          search = mkSearch (Just templateQuery) Nothing+      myTweet <- searchTweet search+      liftIO $ myTweet `shouldBe` Right exampleTweet +   describe "sorting" $ do     it "returns documents in the right order" $ withTestEnv $ do       _ <- insertData@@ -1108,6 +1164,7 @@       let search = Search Nothing                    Nothing (Just [sortSpec]) Nothing Nothing                    False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+                   Nothing       result <- searchTweets search       let myTweet = grabFirst result       liftIO $@@ -1503,11 +1560,11 @@         scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]    describe "index aliases" $ do+    let aname = IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias")+    let alias = IndexAlias (testIndex) aname+    let create = IndexAliasCreate Nothing Nothing+    let action = AddAlias alias create     it "handles the simple case of aliasing an existing index" $ do-      let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))-      let create = IndexAliasCreate Nothing Nothing-      let action = AddAlias alias create-       withTestEnv $ do         resetIndex         resp <- updateIndexAliases (action :| [])@@ -1519,6 +1576,18 @@             Right (IndexAliasesSummary summs) ->               L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected             Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup+    it "allows alias deletion" $ do+      aliases <- withTestEnv $ do+        resetIndex+        resp <- updateIndexAliases (action :| [])+        liftIO $ validateStatus resp 200+        deleteIndexAlias aname+        getIndexAliases+      let expected = IndexAliasSummary alias create+      case aliases of+        Right (IndexAliasesSummary summs) ->+          L.find ((== aname) . indexAlias . indexAliasSummaryAlias) summs `shouldBe` Nothing+        Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)    describe "Index Listing" $ do     it "returns a list of index names" $ withTestEnv $ do@@ -1540,12 +1609,40 @@                                     (IndexSettings (ShardCount 1) (ReplicaCount 0))                                     (NE.toList updates)) +    it "allows total fields to be set" $ when' (atleast es50) $ withTestEnv $ do+      _ <- deleteExampleIndex+      _ <- createExampleIndex+      let updates = MappingTotalFieldsLimit 2500 :| []+      updateResp <- updateIndexSettings updates testIndex+      liftIO $ validateStatus updateResp 200+      getResp <- getIndexSettings testIndex+      liftIO $+        getResp `shouldBe` Right (IndexSettingsSummary+                                    testIndex+                                    (IndexSettings (ShardCount 1) (ReplicaCount 0))+                                    (NE.toList updates))+   describe "Index Optimization" $ do     it "returns a successful response upon completion" $ withTestEnv $ do       _ <- createExampleIndex       resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings       liftIO $ validateStatus resp 200 +  describe "Suggest" $ do+    it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do+      _ <- insertData+      let query = QueryMatchNoneQuery+          phraseSuggester = mkPhraseSuggester (FieldName "message")+          namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)+          search' = mkSearch (Just query) Nothing+          search = search' { suggestBody = Just namedSuggester }+          expectedText = Just "use haskell"+      resp <- searchByIndex testIndex search+      parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))+      case parsed of+        Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)+        Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses  <$> suggest sr) `shouldBe` expectedText+   describe "JSON instances" $ do     propJSON (Proxy :: Proxy Version)     propJSON (Proxy :: Proxy IndexName)@@ -1648,6 +1745,8 @@     propJSON (Proxy :: Proxy InitialShardCount)     propJSON (Proxy :: Proxy FSType)     propJSON (Proxy :: Proxy CompoundFormat)+    propJSON (Proxy :: Proxy TemplateQueryInline)+    propJSON (Proxy :: Proxy Suggest)  -- Temporary solution for lacking of generic derivation of Arbitrary -- We use generics-sop, as it's much more concise than directly using GHC.Generics