bloodhound 0.10.0.0 → 0.11.0.0

raw patch · 8 files changed

+467/−137 lines, 8 filesdep +scientificdep ~aesondep ~hspecdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: scientific

Dependency ranges changed: aeson, hspec, time, transformers

API changes (from Hackage documentation)

Files

• README.md +44/−28
• bloodhound.cabal +9/−5
• changelog.md +38/−0
• src/Database/Bloodhound.hs +4/−1
• src/Database/Bloodhound/Client.hs +112/−27
• src/Database/Bloodhound/Types.hs +130/−60
• src/Database/Bloodhound/Types/Internal.hs +56/−0
• tests/tests.hs +74/−16

@@ -21,15 +21,29 @@ Version compatibility --------------------- -Elasticsearch \>= 1.0 is recommended. Bloodhound mostly works with 0.9.x, but I don't recommend it if you expect everything to work. As of Bloodhound 0.3 all \>=1.0 versions of Elasticsearch work.+Elasticsearch \>=1.0 && \<2.0 is recommended. Bloodhound mostly works with 0.9.x, but I don't recommend it if you expect everything to work. As of Bloodhound 0.3 all \>=1.0 && \<2.0 versions of Elasticsearch work. Some (or even most?) features will work with versions \>=2.0, but it is not officially supported yet. -Current versions we test against are 1.0.3, 1.1.2, 1.2.3, 1.3.2, and 1.4.0. We also check that GHC 7.6 and 7.8 both build and pass tests. See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) to learn more.+Current versions we test against are 1.2.4, 1.3.6, 1.4.1, 1.5.2, 1.6.0, and 1.7.2. We also check that GHC 7.6 and 7.8 both build and pass tests. See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) to learn more.  Stability ---------  Bloodhound is stable for production use. I will strive to avoid breaking API compatibility from here on forward, but dramatic features like a type-safe, fully integrated mapping API may require breaking things in the future. +Testing+---------++The TravisCI tests are run using [Stack](http://docs.haskellstack.org/en/stable/README.html). You should use Stack instead of `cabal` to build and test Bloodhound to avoid compatibility problems. You will also need to have an ElasticSearch instance running at `localhost:9200` in order to execute some of the tests. See the "Version compatibility" section above for a list of ElasticSearch versions that are officially validated against in TravisCI.++Steps to run the tests locally:+  1. Dig through the [past releases] (https://www.elastic.co/downloads/past-releases) section of the ElasticSearch download page and install the desired ElasticSearch versions.+  2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)+  3. In your local Bloodhound directory, run `stack setup && stack build`+  4. Start the desired version of ElasticSearch at `localhost:9200`, which should be the default.+  5. Run `stack test` in your local Bloodhound directory.+  6. The unit tests will pass if you re-execute `stack test`, but some of the doctests might fail due to existing data in ElasticSearch. If you want to start with a clean slate, stop your ElasticSearch instance, delete the `data/` folder in the ElasticSearch installation, restart ElasticSearch, and re-run `stack test`.++ Hackage page and Haddock documentation ====================================== @@ -38,7 +52,7 @@ Elasticsearch Tutorial ====================== -It's not using Bloodhound, but if you need an introduction to or overview of Elasticsearch and how to use it, you can use [this screencast](http://vimeo.com/106463167).+It's not using Bloodhound, but if you need an introduction to or overview of Elasticsearch and how to use it, you can use [this screencast](https://vimeo.com/106463167).  Examples ========@@ -758,7 +772,8 @@  #### Extracting aggregations from results -Aggregations are part of the reply structure of every search, in the form of+Aggregations are part of the reply structure of every search, in the+form of `Maybe AggregationResults`  ``` {.haskell} -- Lift decode and response body to be in the IO monad.@@ -774,7 +789,7 @@ Just (Bucket {buckets = [TermsResult {termKey = "bitemyapp", termsDocCount = 1, termsAggs = Nothing}]}) ``` -Note that bucket aggregation results, such as the TermsResult is a member of the type class :+Note that bucket aggregation results, such as the TermsResult is a member of the type class `BucketAggregation`:  ``` {.haskell} class BucketAggregation a where@@ -783,9 +798,10 @@   aggs :: a -> Maybe AggregationResults ``` -haskell--You can use the function to get any nested results, if there were any. For example, if there were a nested terms aggregation keyed to "age" in a TermsResult named , you would call+You can use the `aggs` function to get any nested results, if there+were any. For example, if there were a nested terms aggregation keyed+to "age" in a TermsResult named `termresult` , you would call `aggs+termresult >>= toTerms "age"`  #### Terms Aggregation @@ -803,7 +819,8 @@                       termAggs :: Maybe Aggregations} ``` -Term Aggregations have two factory functions, , and , and can be used as follows:+Term Aggregations have two factory functions, `mkTermsAggregation`, and+`mkTermsScriptAggregation`, and can be used as follows:  ``` {.haskell} let ta = TermsAgg $ mkTermsAggregation "user"@@ -817,7 +834,7 @@ let ta'' = TermsAgg ta' ``` -For more documentation on how the Terms Aggregation works, see <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-terms-aggregation.html>+For more documentation on how the Terms Aggregation works, see <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-terms-aggregation.html>  #### Date Histogram Aggregation @@ -833,17 +850,15 @@                               dateAggs :: Maybe Aggregations} ``` -haskell- The Date Histogram Aggregation works much the same as the Terms Aggregation. -Relevant functions include , and+Relevant functions include `mkDateHistogram`, and `toDateHistogram`  ``` {.haskell} let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") Minute) ``` -Date histograms also accept a :+Date histograms also accept a `FractionalInterval`:  ``` {.haskell} FractionalInterval :: Float -> TimeInterval -> Interval@@ -857,7 +872,7 @@ let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") (FractionalInterval 1.5 Minutes)) ``` -The is defined as:+The `DateHistogramResult` is defined as:  ``` {.haskell} data DateHistogramResult@@ -867,11 +882,12 @@                          dateHistogramAggs :: Maybe AggregationResults} ``` -It is an instance of , and can have nested aggregations in each bucket.+It is an instance of `BucketAggregation`, and can have nested aggregations in each bucket. -Buckets can be extracted from a using+Buckets can be extracted from an `AggregationResult` using+`toDateHistogram name` -For more information on the Date Histogram Aggregation, see: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>+For more information on the Date Histogram Aggregation, see: <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>   Contributors@@ -894,12 +910,12 @@ Span Queries ------------ -Beginning here: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-span-first-query.html>+Beginning here: <https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-span-first-query.html>  Function Score Query -------------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-function-score-query.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-function-score-query.html>  Node discovery and failover ---------------------------@@ -919,42 +935,42 @@ GeoShapeQuery ------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-geo-shape-query.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-geo-shape-query.html>  GeoShapeFilter -------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-geo-shape-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-geo-shape-filter.html>  Geohash cell filter ------------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-geohash-cell-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-geohash-cell-filter.html>  HasChild Filter --------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-has-child-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-has-child-filter.html>  HasParent Filter ---------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-has-parent-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-has-parent-filter.html>  Indices Filter -------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-indices-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-indices-filter.html>  Query Filter ------------ -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-query-filter.html>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/query-dsl-query-filter.html>  Script based sorting -------------------- -<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_script_based_sorting>+<https://www.elastic.co/guide/en/elasticsearch/reference/current/search-request-sort.html#_script_based_sorting>  Collapsing redundantly nested and/or structures -----------------------------------------------

@@ -1,5 +1,5 @@ name:                bloodhound-version:             0.10.0.0+version:             0.11.0.0 synopsis:            ElasticSearch client library for Haskell description:         ElasticSearch made awesome for Haskell hackers homepage:            https://github.com/bitemyapp/bloodhound@@ -27,20 +27,22 @@                        Database.Bloodhound.Client                        Database.Bloodhound.Types                        Database.Bloodhound.Types.Class+                       Database.Bloodhound.Types.Internal   hs-source-dirs:      src   build-depends:       base             >= 4.3     && <5,                        bytestring       >= 0.10.0  && <0.11,                        containers       >= 0.5.0.0 && <0.6,-                       aeson            >= 0.10    && <0.11,+                       aeson            >= 0.11.1  && <0.12,                        http-client      >= 0.3     && <0.5,                        network-uri      >= 2.6     && <2.7,                        semigroups       >= 0.15    && <0.19,-                       time             >= 1.4     && <1.6,+                       time             >= 1.4     && <1.7,                        text             >= 0.11    && <1.3,                        mtl              >= 1.0     && <2.3,-                       transformers     >= 0.2     && <0.5,+                       transformers     >= 0.2     && <0.6,                        http-types       >= 0.8     && <0.10,                        vector           >= 0.10.9  && <0.12,+                       scientific       >= 0.3.0.0 && <0.4.0.0,                        exceptions,                        data-default-class,                        blaze-builder,@@ -60,7 +62,7 @@                        http-client,                        http-types,                        containers,-                       hspec                >= 1.8 && <2.2,+                       hspec                >= 1.8 && <2.3,                        text,                        time,                        aeson,@@ -82,6 +84,8 @@   hs-source-dirs:   tests, src   if impl(ghc >= 7.8)     build-depends:    base,+                      aeson,+                      bloodhound,                       directory,                       doctest >= 0.10.1,                       doctest-prop,

@@ -1,3 +1,41 @@+0.11.0.0+===================++Thanks to the following people, Bloodhound 0.10.0.0 is being released! This one gets a bit messy due to the Aeson 0.11 changeover, but this should be good to go now. Note that Aeson 0.11 returned to Aeson 0.9's behavior and semantics.++* @MichaelXavier+  - #112 List indices support+  - #94 Implement index optimization+  - #91 Make `respIsTwoHunna` more semantic+    - More detail: This is actually the cause of a bug in real code. If you happen to be+      using parseEsResponse (which uses respIsTwoHunna) to parse the result of+      certain operations such as creating an index, those operations return a+      201 and unjustly are deemed to be a failure.+  - Cleaned up errant Haskell tokens in README+  - #84 Added request auth hooks++* @dzhus / @MailOnline+  - #85 Add updateDocument++* @ReadmeCritic+  - #108 Update README URLs based on HTTP redirects++* @MHova+  - #105 Add helper data types and functions for Missing Aggregations+  - Removed unused server versions from the tests+  - Updated readme to reflect actual ES versions supported and tested+  - Added support for parsing results of Missing Aggregations+  - #104 Export BucketValue+  - #102 Add local testing instructions to the README+  - #89 Support Bool and Numeric keys in TermsResults+  - Added Missing Aggregation support+  - #98 Improve EsProtocolException documentation for human error+  - Updated README to warn about 2.0 compatibility+  - Fix docs specifying an incorrect terminating condition++* @bitemyapp+  - Merge monkey, puzzled over spurious local doctest failures+ 0.10.0.0 =================== 

@@ -1,7 +1,10 @@ module Database.Bloodhound-       ( module Database.Bloodhound.Client+       ( -- module Data.Aeson.Types+       -- , +         module Database.Bloodhound.Client        , module Database.Bloodhound.Types        ) where +-- import Data.Aeson.Types import Database.Bloodhound.Client import Database.Bloodhound.Types

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TupleSections     #-}  ------------------------------------------------------------------------------- -- |@@ -26,9 +27,11 @@        , deleteIndex        , updateIndexSettings        , getIndexSettings+       , optimizeIndex        , indexExists        , openIndex        , closeIndex+       , listIndices        , updateIndexAliases        , getIndexAliases        , putTemplate@@ -37,6 +40,7 @@        , putMapping        , deleteMapping        , indexDocument+       , updateDocument        , getDocument        , documentExists        , deleteDocument@@ -57,6 +61,8 @@        , getStatus        , encodeBulkOperations        , encodeBulkOperation+       -- * Authentication+       , basicAuthHook        -- * Reply-handling tools        , isVersionConflict        , isSuccess@@ -78,7 +84,7 @@ import           Data.Ix import qualified Data.List                    as LS (filter, foldl') import           Data.List.NonEmpty           (NonEmpty (..))-import           Data.Maybe                   (fromMaybe, isJust)+import           Data.Maybe                   (catMaybes, fromMaybe, isJust) import           Data.Monoid import           Data.Text                    (Text) import qualified Data.Text                    as T@@ -174,10 +180,11 @@             -> m Reply dispatch dMethod url body = do   initReq <- liftIO $ parseUrl' url+  reqHook <- bhRequestHook <$> getBHEnv   let reqBody = RequestBodyLBS $ fromMaybe emptyBody body-  let req = initReq { method = dMethod-                    , requestBody = reqBody-                    , checkStatus = \_ _ _ -> Nothing}+  req <- liftIO $ reqHook $ initReq { method = dMethod+                                    , requestBody = reqBody+                                    , checkStatus = \_ _ _ -> Nothing}   mgr <- bhManager <$> getBHEnv   liftIO $ httpLbs req mgr @@ -221,8 +228,7 @@ withBH :: ManagerSettings -> Server -> BH IO a -> IO a withBH ms s f = do   mgr <- newManager ms-  let env = BHEnv { bhServer  = s-                  , bhManager = mgr }+  let env = mkBHEnv s mgr   runBH env f  -- Shortcut functions for HTTP methods@@ -248,11 +254,9 @@ -- Just 200 getStatus :: MonadBH m => m (Maybe Status) getStatus = do-  url <- joinPath []-  request <- liftIO $ parseUrl' url-  mgr <- bhManager <$> getBHEnv-  response <- liftIO $ httpLbs request mgr+  response <- get =<< url   return $ decode (responseBody response)+  where url = joinPath []  -- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'. --@@ -301,6 +305,48 @@   where url = joinPath [indexName, "_settings"]  +-- | 'optimizeIndex' will optimize a single index, list of indexes or+-- all indexes. Note that this call will block until finishing but+-- will continue even if the request times out. Concurrent requests to+-- optimize an index while another is performing will block until the+-- previous one finishes. For more information see+-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing+-- worthwhile comes back in the reply body, so matching on the status+-- should suffice.+--+-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes+-- to True is the main way to release disk space back to the OS being+-- held by deleted documents.+--+-- Note that this API was deprecated in ElasticSearch 2.1 for the+-- almost completely identical forcemerge API. Adding support to that+-- API would be trivial but due to the significant breaking changes,+-- this library cannot currently be used with >= 2.0, so that feature was omitted.+--+-- >>> let ixn = IndexName "unoptimizedindex"+-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn+-- >>> response <- runBH' $ optimizeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })+-- >>> respIsTwoHunna response+-- True+optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply+optimizeIndex ixs IndexOptimizationSettings {..} =+    bindM2 post url (return body)+  where url = addQuery params <$> joinPath [indexName, "_optimize"]+        params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments+                           , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))+                           , Just ("flush", Just (boolQP flushAfterOptimize))+                           ]+        indexName = indexSelectionName ixs+        boolQP True = "true"+        boolQP False = "false"+        body = Nothing+++-------------------------------------------------------------------------------+indexSelectionName :: IndexSelection -> Text+indexSelectionName (IndexList names) = T.intercalate "," [n | IndexName n <- toList names]+indexSelectionName AllIndexes        = "_all"+ deepMerge :: [Object] -> Object deepMerge = LS.foldl' go mempty   where go acc = LS.foldl' go' acc . HM.toList@@ -309,11 +355,11 @@         merge _ b = b  -statusCodeIs :: Int -> Reply -> Bool-statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n+statusCodeIs :: (Int, Int) -> Reply -> Bool+statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)  respIsTwoHunna :: Reply -> Bool-respIsTwoHunna = statusCodeIs 200+respIsTwoHunna = statusCodeIs (200, 299)  existentialQuery :: MonadBH m => Text -> m (Reply, Bool) existentialQuery url = do@@ -385,6 +431,19 @@ closeIndex :: MonadBH m => IndexName -> m Reply closeIndex = openOrCloseIndexes CloseIndex +-- | 'listIndices' returns a list of all index names on a given 'Server'+listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]+listIndices =+  parse . responseBody =<< get =<< url+  where+    url = joinPath ["_cat/indices?v"]+    -- parses the tabular format the indices api provides+    parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of+      (hdr:rows) -> let ks = T.words hdr+                        keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]+                        names = catMaybes (HM.lookup "index" <$> keyedRows)+                    in return (IndexName <$> names)+      [] -> throwM (EsProtocolException body)  -- | 'updateIndexAliases' updates the server's index alias -- table. Operations are atomic. Explained in further detail at@@ -394,6 +453,7 @@ -- >>> let aliasName = IndexName "an-alias" -- >>> let iAlias = IndexAlias src (IndexAliasName aliasName) -- >>> let aliasCreate = IndexAliasCreate Nothing Nothing+-- >>> _ <- runBH' $ deleteIndex src -- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src) -- True -- >>> runBH' $ indexExists src@@ -474,6 +534,20 @@   -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"   delete =<< joinPath [indexName, "_mapping", mappingName] +versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]+versionCtlParams cfg =+  case idsVersionControl cfg of+    NoVersionControl -> []+    InternalVersion v -> versionParams v "internal"+    ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"+    ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"+    ForceVersion (ExternalDocVersion v) -> versionParams v "force"+  where+    vt = showText . docVersionNumber+    versionParams v t = [ ("version", Just $ vt v)+                        , ("version_type", Just t)+                        ]+ -- | 'indexDocument' is the primary way to save a single document in --   Elasticsearch. The document itself is simply something we can --   convert into a JSON 'Value'. The 'DocId' will function as the@@ -488,22 +562,23 @@   (MappingName mappingName) cfg document (DocId docId) =   bindM2 put url (return body)   where url = addQuery params <$> joinPath [indexName, mappingName, docId]-        versionCtlParams = case idsVersionControl cfg of-          NoVersionControl -> []-          InternalVersion v -> versionParams v "internal"-          ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"-          ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"-          ForceVersion (ExternalDocVersion v) -> versionParams v "force"-        vt = T.pack . show . docVersionNumber-        versionParams v t = [ ("version", Just $ vt v)-                            , ("version_type", Just t)-                            ]         parentParams = case idsParent cfg of           Nothing -> []           Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]-        params = versionCtlParams ++ parentParams+        params = versionCtlParams cfg ++ parentParams         body = Just (encode document) +-- | 'updateDocument' provides a way to perform an partial update of a+-- an already indexed document.+updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName+                  -> IndexDocumentSettings -> patch -> DocId -> m Reply+updateDocument (IndexName indexName)+  (MappingName mappingName) cfg patch (DocId docId) =+  bindM2 post url (return body)+  where url = addQuery (versionCtlParams cfg) <$>+              joinPath [indexName, mappingName, docId, "_update"]+        body = Just (encode $ object ["doc" .= toJSON patch])+ -- | 'deleteDocument' is the primary way to delete a single document. -- -- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")@@ -664,9 +739,8 @@       Right SearchResult {..} -> return (hits searchHits, scrollId)       Left _ -> return ([], Nothing) --- | Use the given scroll to fetch the next page of documents. If--- there are still further pages, there will be a value in the--- 'scrollId' field of the 'SearchResult'+-- | Use the given scroll to fetch the next page of documents. If there are no+-- further pages, 'SearchResult.searchHits.hits' will be '[]'. advanceScroll   :: ( FromJSON a      , MonadBH m@@ -769,3 +843,14 @@  statusCheck :: (Int -> Bool) -> Reply -> Bool statusCheck prd = prd . NHTS.statusCode . responseStatus++-- | This is a hook that can be set via the 'bhRequestHook' function+-- that will authenticate all requests using an HTTP Basic+-- Authentication header. Note that it is *strongly* recommended that+-- this option only be used over an SSL connection.+--+-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }+basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request+basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'+  where u' = T.encodeUtf8 u+        p' = T.encodeUtf8 p

@@ -4,15 +4,16 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE NoMonomorphismRestriction  #-}+-- {-# LANGUAGE NoMonomorphismRestriction  #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE NamedFieldPuns             #-}  ------------------------------------------------------------------------------- -- | -- Module : Database.Bloodhound.Types--- Copyright : (C) 2014 Chris Allen+-- Copyright : (C) 2014, 2015, 2016 Chris Allen -- License : BSD-style (see the file LICENSE) -- Maintainer : Chris Allen <cma@bitemyapp.com -- Stability : provisional@@ -46,12 +47,17 @@        , mkDateHistogram        , mkDocVersion        , docVersionNumber+       , toMissing        , toTerms        , toDateHistogram        , omitNulls        , BH(..)        , runBH-       , BHEnv(..)+       , BHEnv+       , bhServer+       , bhManager+       , bhRequestHook+       , mkBHEnv        , MonadBH(..)        , Version(..)        , Status(..)@@ -136,6 +142,9 @@        , FieldName(..)        , Script(..)        , IndexName(..)+       , IndexSelection(..)+       , IndexOptimizationSettings(..)+       , defaultIndexOptimizationSettings        , TemplateName(..)        , TemplatePattern(..)        , MappingName(..)@@ -230,9 +239,11 @@        , Aggregation(..)        , Aggregations        , AggregationResults+       , BucketValue(..)        , Bucket(..)        , BucketAggregation(..)        , TermsAggregation(..)+       , MissingAggregation(..)        , ValueCountAggregation(..)        , FilterAggregation(..)        , DateHistogramAggregation(..)@@ -255,9 +266,13 @@        , HighlightTag(..)        , HitHighlight +       , MissingResult(..)        , TermsResult(..)        , DateHistogramResult(..)        , DateRangeResult(..)++       , EsUsername(..)+       , EsPassword(..)          ) where  import           Control.Applicative@@ -267,33 +282,36 @@ import           Control.Monad.State import           Control.Monad.Writer import           Data.Aeson-import           Data.Aeson.Types                (Pair, Parser, emptyObject,-                                                  parseMaybe)-import qualified Data.ByteString.Lazy.Char8      as L+import           Data.Aeson.Types                   (Pair, Parser, emptyObject,+                                                     parseMaybe)+import qualified Data.ByteString.Lazy.Char8         as L import           Data.Char-import           Data.Hashable                   (Hashable)-import qualified Data.HashMap.Strict             as HM-import           Data.List                       (foldl', nub)-import           Data.List.NonEmpty              (NonEmpty (..), toList)-import qualified Data.Map.Strict                 as M+import           Data.Hashable                      (Hashable)+import qualified Data.HashMap.Strict                as HM+import           Data.List                          (foldl', nub)+import           Data.List.NonEmpty                 (NonEmpty (..), toList)+import qualified Data.Map.Strict                    as M import           Data.Maybe-import           Data.Text                       (Text)-import qualified Data.Text                       as T+import           Data.Scientific                    (Scientific)+import           Data.Text                          (Text)+import qualified Data.Text                          as T import           Data.Time.Calendar-import           Data.Time.Clock                 (NominalDiffTime, UTCTime)+import           Data.Time.Clock                    (NominalDiffTime, UTCTime) import           Data.Time.Clock.POSIX-import qualified Data.Traversable                as DT-import           Data.Typeable                   (Typeable)-import qualified Data.Vector                     as V+import qualified Data.Traversable                   as DT+import           Data.Typeable                      (Typeable)+import qualified Data.Vector                        as V import           GHC.Enum-import           GHC.Generics                    (Generic)+import           GHC.Generics                       (Generic) import           Network.HTTP.Client-import qualified Network.HTTP.Types.Method       as NHTM+import qualified Network.HTTP.Types.Method          as NHTM  import           Database.Bloodhound.Types.Class+import           Database.Bloodhound.Types.Internal  -- $setup -- >>> :set -XOverloadedStrings+-- >>> import Data.Aeson -- >>> import Database.Bloodhound -- >>> let testServer = (Server "http://localhost:9200") -- >>> let testIndex = IndexName "twitter"@@ -303,20 +321,12 @@ -- defaultIndexSettings is exported by Database.Bloodhound as well -- no trailing slashes in servers, library handles building the path. -{-| Common environment for Elasticsearch calls. Connections will be-    pipelined according to the provided HTTP connection manager.--}-data BHEnv = BHEnv { bhServer  :: Server-                   , bhManager :: Manager-                   }--{-| All API calls to Elasticsearch operate within-    MonadBH. The idea is that it can be easily embedded in your-    own monad transformer stack. A default instance for a ReaderT and-    alias 'BH' is provided for the simple case.--}-class (Functor m, Applicative m, MonadIO m) => MonadBH m where-  getBHEnv :: m BHEnv+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook+-- will be a noop. You can use the exported fields to customize it further, e.g.:+--+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }+mkBHEnv :: Server -> Manager -> BHEnv+mkBHEnv s m = BHEnv s m return  newtype BH m a = BH {       unBH :: ReaderT BHEnv m a@@ -345,10 +355,6 @@ instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where   getBHEnv = BH getBHEnv --instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where-  getBHEnv = ask- runBH :: BHEnv -> BH m a -> m a runBH e f = runReaderT (unBH f) e @@ -385,6 +391,28 @@ defaultIndexSettings :: IndexSettings defaultIndexSettings =  IndexSettings (ShardCount 3) (ReplicaCount 2) ++{-| 'IndexOptimizationSettings' is used to configure index optimization. See+    <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>+    for more info.+-}+data IndexOptimizationSettings =+  IndexOptimizationSettings { maxNumSegments     :: Maybe Int+                            -- ^ Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.+                            , onlyExpungeDeletes :: Bool+                            -- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.+                            , flushAfterOptimize :: Bool+                            -- ^ Should a flush be performed after the optimize.+                            } deriving (Eq, Show, Generic, Typeable)+++{-| 'defaultIndexOptimizationSettings' implements the default settings that+    ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,+    'onlyExpungeDeletes' is False, and flushAfterOptimize is True.+-}+defaultIndexOptimizationSettings :: IndexOptimizationSettings+defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True+ {-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.     <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>@@ -479,9 +507,9 @@  newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON ::  NominalDiffTime } -data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName+data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName     :: IndexName                                                  , sSummaryFixedSettings :: IndexSettings-                                                 , sSummaryUpdateable :: [UpdatableIndexSetting]}+                                                 , sSummaryUpdateable    :: [UpdatableIndexSetting]}                                                  deriving (Eq, Show, Generic, Typeable)  {-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}@@ -566,10 +594,13 @@ data EsError = EsError { errorStatus  :: Int                        , errorMessage :: Text } deriving (Eq, Show, Generic, Typeable) -{-| 'EsProtocolException' ideally should never be thrown. It will only-be thrown when Bloodhound can't parse a response returned by the-ElasticSearch server. This should be reported as a bug to the bug-tracker. Be sure to include the body.+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response+returned by the ElasticSearch server. If you encounter this error, please+verify that your domain data types and FromJSON instances are working properly+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're+sure that your mappings are correct, then this error may be an indication of an+incompatibility between Bloodhound and ElasticSearch. Please open a bug report+and be sure to include the exception body. -} data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }                                                deriving (Eq, Show, Generic, Typeable)@@ -764,14 +795,16 @@ -} newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic, ToJSON, Typeable) -{-| 'Server' is used with the client functions to point at the ES instance--}-newtype Server = Server Text deriving (Eq, Show, Generic, Typeable)- {-| 'IndexName' is used to describe which index to query/create/delete -} newtype IndexName = IndexName Text deriving (Eq, Generic, Show, ToJSON, FromJSON, Typeable) +{-| 'IndexSelection' is used for APIs which take a single index, a list of+    indexes, or the special @_all@ index.+-}+data IndexSelection = IndexList (NonEmpty IndexName)+                    | AllIndexes deriving (Eq, Generic, Show, Typeable)+ {-| 'TemplateName' is used to describe which template to query/create/delete -} newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic, ToJSON, FromJSON, Typeable)@@ -1549,8 +1582,12 @@                  | DateHistogramAgg DateHistogramAggregation                  | ValueCountAgg ValueCountAggregation                  | FilterAgg FilterAggregation-                 | DateRangeAgg DateRangeAggregation deriving (Eq, Show, Generic, Typeable)+                 | DateRangeAgg DateRangeAggregation+                 | MissingAgg MissingAggregation deriving (Eq, Show, Generic, Typeable) +data MissingAggregation = MissingAggregation+  { maField :: Text+  } deriving (Eq, Show, Generic, Typeable)  data TermsAggregation = TermsAggregation { term              :: Either Text Text                                          , termInclude       :: Maybe TermInclusion@@ -1710,6 +1747,8 @@               , "aggs" .= ags]   toJSON (DateRangeAgg a) = object [ "date_range" .= a                                    ]+  toJSON (MissingAgg (MissingAggregation{..})) =+    object ["missing" .= object ["field" .= maField]]  instance ToJSON DateRangeAggregation where   toJSON DateRangeAggregation {..} =@@ -1745,14 +1784,20 @@ type AggregationResults = M.Map Text Value  class BucketAggregation a where-  key :: a -> Text+  key :: a -> BucketValue   docCount :: a -> Int   aggs :: a -> Maybe AggregationResults   data Bucket a = Bucket { buckets :: [a]} deriving (Show) -data TermsResult = TermsResult { termKey       :: Text+data BucketValue = TextValue Text+                 | ScientificValue Scientific+                 | BoolValue Bool deriving (Show)++data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)++data TermsResult = TermsResult { termKey       :: BucketValue                                , termsDocCount :: Int                                , termsAggs     :: Maybe AggregationResults } deriving (Show) @@ -1770,11 +1815,16 @@                                        , dateRangeAggs         :: Maybe AggregationResults } deriving (Show, Eq, Generic, Typeable)  toTerms :: Text -> AggregationResults ->  Maybe (Bucket TermsResult)-toTerms t a = M.lookup t a >>= deserialize-  where deserialize = parseMaybe parseJSON+toTerms = toAggResult  toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)-toDateHistogram t a = M.lookup t a >>= deserialize+toDateHistogram = toAggResult++toMissing :: Text -> AggregationResults -> Maybe MissingResult+toMissing = toAggResult++toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a+toAggResult t a = M.lookup t a >>= deserialize   where deserialize = parseMaybe parseJSON  instance BucketAggregation TermsResult where@@ -1783,12 +1833,12 @@   aggs = termsAggs  instance BucketAggregation DateHistogramResult where-  key = showText . dateKey+  key = TextValue . showText . dateKey   docCount = dateDocCount   aggs = dateHistogramAggs  instance BucketAggregation DateRangeResult where-  key = dateRangeKey+  key = TextValue . dateRangeKey   docCount = dateRangeDocCount   aggs = dateRangeAggs @@ -1797,6 +1847,16 @@                          v .: "buckets"   parseJSON _ = mempty +instance FromJSON BucketValue where+  parseJSON (String t) = return $ TextValue t+  parseJSON (Number s) = return $ ScientificValue s+  parseJSON (Bool b) = return $ BoolValue b+  parseJSON _ = mempty++instance FromJSON MissingResult where+  parseJSON = withObject "MissingResult" parse+    where parse v = MissingResult <$> v .: "doc_count"+ instance FromJSON TermsResult where   parseJSON (Object v) = TermsResult <$>                          v .:   "key"       <*>@@ -2037,6 +2097,7 @@   toJSON (TermsQuery fieldName terms) =     object [ "terms" .= object conjoined ]     where conjoined = [fieldName .= terms]+   toJSON (IdsQuery idsQueryMappingName docIds) =     object [ "ids" .= object conjoined ]     where conjoined = [ "type"   .= idsQueryMappingName@@ -2424,7 +2485,8 @@                     <*> o .:? "percent_terms_to_match"                     <*> o .:? "min_term_freq"                     <*> o .:? "max_query_terms"-                    <*> (optionalNE =<< o .:? "stop_words")+                    -- <*> (optionalNE =<< o .:? "stop_words")+                    <*> o .:? "stop_words"                     <*> o .:? "min_doc_freq"                     <*> o .:? "max_doc_freq"                     <*> o .:? "min_word_length"@@ -2432,7 +2494,7 @@                     <*> o .:? "boost_terms"                     <*> o .:? "boost"                     <*> o .:? "analyzer"-          optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)+          -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)  instance ToJSON MoreLikeThisQuery where   toJSON (MoreLikeThisQuery text fields percent@@ -2457,11 +2519,13 @@   parseJSON = withObject "MoreLikeThisQuery" parse     where parse o = MoreLikeThisQuery                     <$> o .: "like_text"-                    <*> (optionalNE =<< o .:? "fields")+                    -- <*> (optionalNE =<< o .:? "fields")+                    <*> o .:? "fields"                     <*> o .:? "percent_terms_to_match"                     <*> o .:? "min_term_freq"                     <*> o .:? "max_query_terms"-                    <*> (optionalNE =<< o .:? "stop_words")+                    -- <*> (optionalNE =<< o .:? "stop_words")+                    <*> o .:? "stop_words"                     <*> o .:? "min_doc_freq"                     <*> o .:? "max_doc_freq"                     <*> o .:? "min_word_length"@@ -2469,7 +2533,7 @@                     <*> o .:? "boost_terms"                     <*> o .:? "boost"                     <*> o .:? "analyzer"-          optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)+          -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)  instance ToJSON IndicesQuery where   toJSON (IndicesQuery indices query noMatch) =@@ -3544,3 +3608,9 @@   fromEnum = docVersionNumber   enumFrom = boundedEnumFrom   enumFromThen = boundedEnumFromThen++-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Show, Eq)++-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Show, Eq)

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-------------------------------------------------------------------------------+-- |+-- Module : Database.Bloodhound.Types.Internal+-- Copyright : (C) 2014 Chris Allen+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Chris Allen <cma@bitemyapp.com>+-- Stability : provisional+-- Portability : DeriveGeneric, RecordWildCards+--+-- Internal data types for Bloodhound. These types may change without+-- notice so import at your own risk.+-------------------------------------------------------------------------------+module Database.Bloodhound.Types.Internal+    ( BHEnv(..)+    , Server(..)+    , MonadBH(..)+    ) where+++import           Control.Applicative+import           Control.Monad.Reader+import           Data.Text            (Text)+import           Data.Typeable        (Typeable)+import           GHC.Generics         (Generic)+import           Network.HTTP.Client++{-| Common environment for Elasticsearch calls. Connections will be+    pipelined according to the provided HTTP connection manager.+-}+data BHEnv = BHEnv { bhServer      :: Server+                   , bhManager     :: Manager+                   , bhRequestHook :: Request -> IO Request+                   -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.+                   }++instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where+  getBHEnv = ask++{-| 'Server' is used with the client functions to point at the ES instance+-}+newtype Server = Server Text deriving (Eq, Show, Generic, Typeable)++{-| All API calls to Elasticsearch operate within+    MonadBH+    . The idea is that it can be easily embedded in your+    own monad transformer stack. A default instance for a ReaderT and+    alias 'BH' is provided for the simple case.+-}+class (Functor m, Applicative m, MonadIO m) => MonadBH m where+  getBHEnv :: m BHEnv+

@@ -66,9 +66,6 @@  data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord) -es14 :: ServerVersion-es14 = ServerVersion 1 4 0- es13 :: ServerVersion es13 = ServerVersion 1 3 0 @@ -78,9 +75,6 @@ es11 :: ServerVersion es11 = ServerVersion 1 1 0 -es10 :: ServerVersion-es10 = ServerVersion 1 0 0- serverBranch :: ServerVersion -> ServerVersion serverBranch (ServerVersion majorVer minorVer patchVer) =   ServerVersion majorVer minorVer patchVer@@ -130,7 +124,8 @@                    , postDate :: UTCTime                    , message  :: Text                    , age      :: Int-                   , location :: Location }+                   , location :: Location+                   , extra    :: Maybe Text }            deriving (Eq, Generic, Show)  instance ToJSON   Tweet where@@ -178,8 +173,34 @@                                   (secondsToDiffTime 10)                      , message  = "Use haskell!"                      , age      = 10000-                     , location = Location 40.12 (-71.34) }+                     , 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@@ -187,7 +208,8 @@                                 (secondsToDiffTime 11)                    , message  = "Use haskell!"                    , age      = 1000-                   , location = Location 40.12 (-71.34) }+                   , location = Location 40.12 (-71.34)+                   , extra = Nothing }  resetIndex :: BH IO () resetIndex = do@@ -207,12 +229,24 @@   _ <- 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")@@ -238,7 +272,7 @@  searchExpectAggs :: Search -> BH IO () searchExpectAggs search = do-  reply <- searchAll search+  reply <- searchByIndex testIndex search   let isEmpty x = return (M.null x)   let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)   liftIO $@@ -247,7 +281,7 @@ searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>                         Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO () searchValidBucketAgg search aggKey extractor = do-  reply <- searchAll search+  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)@@ -272,8 +306,8 @@   _ <- insertData   let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")   let search = (mkSearch (Just query) Nothing) { source = Just src }-  reply <- searchAll search-  result <- parseEsResponse reply--  :: Either EsError (SearchResult Value)+  reply <- searchByIndex testIndex search+  result <- parseEsResponse reply   let value = grabFirst result   liftIO $     value `shouldBe` expected@@ -761,12 +795,13 @@       liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))    describe "document API" $ do-    it "indexes, gets, and then deletes the generated document" $ withTestEnv $ 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 exampleTweet))+      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@@ -1214,6 +1249,16 @@       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@@ -1262,7 +1307,8 @@      it "excludes source patterns" $ withTestEnv $ do       searchExpectSource-        (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))+        (SourceIncludeExclude (Include [])+        (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))         (Right (Object (HM.fromList [("user",String "bitemyapp")])))    describe "ToJSON RegexpFlags" $ do@@ -1380,6 +1426,12 @@               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@@ -1393,6 +1445,12 @@                                     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 "JSON instances" $ do     propJSON (Proxy :: Proxy Version)