bloodhound-1.0.0.0: tests/Test/IndicesSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.IndicesSpec where
import Control.Exception (finally)
import Control.Monad.Catch (bracket_)
import Data.Aeson.Key (fromText, toText)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as BL8
import Data.List qualified as L
import Data.Map qualified as M
import Data.Text qualified as T
import Database.Bloodhound.Client.Cluster (BackendType (..))
import TestsUtils.Common
import TestsUtils.Import
checkHasSettings :: [UpdatableIndexSetting] -> BH IO ()
checkHasSettings settings = do
IndexSettingsSummary _ _ currentSettings <- performBHRequest $ getIndexSettings testIndex
liftIO $ L.intersect currentSettings settings `shouldBe` settings
-- | 'True' when the list contains a 'NumberOfReplicas' entry. Used to
-- verify the @GET /{index}@ parser filters it out of the updateable
-- settings list (it's already carried by 'indexReplicas').
hasNumberOfReplicas :: [UpdatableIndexSetting] -> Bool
hasNumberOfReplicas = any isNumberOfReplicas
where
isNumberOfReplicas (NumberOfReplicas _) = True
isNumberOfReplicas _ = False
-- | Navigate the @GET /{index}/_mapping@ response envelope
-- @{\<index\>: {mappings: {properties: {message: {type: ...}}}}}@
-- and return the @type@ of the @message@ field. Used to verify
-- 'getMapping' round-trips a mapping installed with 'putMapping'.
extractMessageType :: Value -> Either String T.Text
extractMessageType = parseEither parser
where
parser =
withObject "mapping response" $ \top ->
case KM.elems top of
(idxBody : _) -> withObject "index body" indexBody idxBody
[] -> fail "empty mapping response"
indexBody body = do
mappings <- body .: "mappings"
props <- withObject "mappings" (.: "properties") mappings
fieldDef <- withObject "properties" (.: "message") props
withObject "message field" (.: "type") fieldDef
-- | Navigate the @GET /{index}/_mapping/field/<field>@ response envelope
-- @{\<index\>: {mappings: {\<field\>: {mapping: {\<field\>: {type: ...}}}}}}@
-- and return the @type@ of the requested field. Used to verify
-- 'getFieldMapping' returns the per-field mapping it was asked for.
extractFieldMappingType :: T.Text -> Value -> Either String T.Text
extractFieldMappingType fieldName = parseEither parser
where
parser =
withObject "field mapping response" $ \top ->
case KM.elems top of
(idxBody : _) -> withObject "index body" indexBody idxBody
[] -> fail "empty field mapping response"
indexBody body = do
mappings <- body .: "mappings"
fieldDef <- withObject "mappings" (.: fromText fieldName) mappings
inner <- withObject "field envelope" (.: "mapping") fieldDef
leaf <- withObject "mapping blob" (.: fromText fieldName) inner
withObject "field type" (.: "type") leaf
-- | First shard copy across all shard numbers in a segments response.
-- Used by the @GET /{index}/_segments@ spec to navigate the
-- @indices -> {<idx>: {shards: {<n>: [<copy>, ...]}}}@ envelope.
firstShardCopy :: M.Map Text [IndexSegmentsShard] -> Maybe IndexSegmentsShard
firstShardCopy shardsMap =
case concat (M.elems shardsMap) of
(copy : _) -> Just copy
[] -> Nothing
-- | First segment (by segment id) in a shard copy.
firstSegment :: IndexSegmentsShard -> Maybe SegmentInfo
firstSegment shardCopy =
case M.elems (indexSegmentsShardSegments shardCopy) of
(seg : _) -> Just seg
[] -> Nothing
-- | First store copy across all shard numbers in a shard stores
-- response. Used by the @GET /{index}/_shard_stores@ spec to navigate
-- the @indices -> {<idx>: {shards: {<n>: {stores: [<copy>, ...]}}}}@
-- envelope.
firstShardStore :: M.Map Text ShardStoresShard -> Maybe ShardStore
firstShardStore shardsMap =
case concatMap shardStoresShardStores (M.elems shardsMap) of
(copy : _) -> Just copy
[] -> Nothing
spec :: Spec
spec = 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 "Index aliases" $ do
let aName = IndexAliasName ([qqIndexName|bloodhound-tests-twitter-1-alias|])
let alias = IndexAlias testIndex aName
let create = defaultIndexAliasCreate
let action = AddAlias alias create
it "handles the simple case of aliasing an existing index" $ do
withTestEnv $ do
resetIndex
(resp, _) <- performBHRequest $ keepBHResponse $ updateIndexAliases (action :| [])
liftIO $ validateStatus resp 200
let cleanup = withTestEnv (performBHRequest $ updateIndexAliases (RemoveAlias alias :| []))
( do
IndexAliasesSummary summs <- withTestEnv (performBHRequest getIndexAliases)
let expected = IndexAliasSummary alias create
L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
)
`finally` cleanup
it "allows alias deletion" $ do
IndexAliasesSummary summs <- withTestEnv $ do
resetIndex
(resp, _) <- performBHRequest $ keepBHResponse $ updateIndexAliases (action :| [])
liftIO $ validateStatus resp 200
_ <- performBHRequest $ deleteIndexAlias aName
performBHRequest getIndexAliases
-- let expected = IndexAliasSummary alias create
L.find
( (== aName)
. indexAlias
. indexAliasSummaryAlias
)
summs
`shouldBe` Nothing
it "reports whether an alias exists (aliasExists)" $ do
withTestEnv $ do
resetIndex
(resp, _) <- performBHRequest $ keepBHResponse $ updateIndexAliases (action :| [])
liftIO $ validateStatus resp 200
present <- performBHRequest $ aliasExists aName
absent <- performBHRequest $ aliasExists (IndexAliasName [qqIndexName|bloodhound-tests-no-such-alias|])
liftIO $ do
present `shouldBe` True
absent `shouldBe` False
it "creates a single alias via PUT /{index}/_alias/{name} (createIndexAlias)" $ do
withTestEnv $ do
resetIndex
let writeCreate = defaultIndexAliasCreate {aliasCreateIsWriteIndex = Just True}
resp <- performBHRequest $ createIndexAlias testIndex aName writeCreate
liftIO $ isAcknowledged resp `shouldBe` True
present <- performBHRequest $ aliasExists aName
liftIO $ present `shouldBe` True
IndexAliasesSummary summs <- performBHRequest getIndexAliases
let found = L.find ((== alias) . indexAliasSummaryAlias) summs
writeFlag = (aliasCreateIsWriteIndex . indexAliasSummaryCreate) <$> found
liftIO $ writeFlag `shouldBe` Just (Just True)
it "round-trips is_write_index through updateIndexAliases and getIndexAliases" $ do
let writeCreate = defaultIndexAliasCreate {aliasCreateIsWriteIndex = Just True}
writeAction = AddAlias alias writeCreate
IndexAliasesSummary summs <-
( do
withTestEnv $ do
resetIndex
(resp, _) <- performBHRequest $ keepBHResponse $ updateIndexAliases (writeAction :| [])
liftIO $ validateStatus resp 200
performBHRequest getIndexAliases
)
`finally` withTestEnv (performBHRequest $ updateIndexAliases (RemoveAlias alias :| []))
let found = L.find ((== alias) . indexAliasSummaryAlias) summs
writeFlag = aliasCreateIsWriteIndex . indexAliasSummaryCreate <$> found
writeFlag `shouldBe` Just (Just True)
it "accepts master_timeout on updateIndexAliasesWith" $ do
let opts = defaultUpdateAliasesOptions {uaoMasterTimeout = Just (TimeUnitSeconds, 1)}
withTestEnv $ do
resetIndex
(resp, _) <-
performBHRequest $
keepBHResponse $
updateIndexAliasesWith opts (action :| [])
liftIO $ validateStatus resp 200
_ <- performBHRequest $ updateIndexAliases (RemoveAlias alias :| [])
pure ()
it "deleteIndexAliasFrom only detaches the alias from the named source index" $
let otherSrc = [qqIndexName|bloodhound-tests-delete-alias-from-other|]
otherAlias = IndexAlias otherSrc aName
addOther = AddAlias otherAlias create
in ( do
IndexAliasesSummary summs <-
withTestEnv $ do
resetIndex
_ <- tryEsError $ performBHRequest $ deleteIndex otherSrc
_ <- performBHRequest $ createIndex defaultIndexSettings otherSrc
_ <- performBHRequest $ updateIndexAliases (action :| [])
_ <- performBHRequest $ updateIndexAliases (addOther :| [])
_ <- performBHRequest $ deleteIndexAliasFrom testIndex aName
performBHRequest getIndexAliases
-- The alias should no longer be attached to @testIndex@...
let onTest = L.find (\s -> indexAliasSummaryAlias s == alias) summs
onTest `shouldBe` Nothing
-- ...but it should still be attached to @otherSrc@.
let onOther = L.find (\s -> indexAliasSummaryAlias s == otherAlias) summs
onOther `shouldSatisfy` isJust
)
`finally` withTestEnv (tryEsError $ performBHRequest $ deleteIndex otherSrc)
it "GET /{index}/_alias/{name} (getIndexAlias) returns the named alias" $
let otherAName = IndexAliasName [qqIndexName|bloodhound-tests-get-index-alias-just-other|]
in ( do
IndexAliasesInfo summs <-
withTestEnv $ do
resetIndex
resp <- performBHRequest $ createIndexAlias testIndex aName create
liftIO $ isAcknowledged resp `shouldBe` True
-- Attach a second alias to the same index so the
-- @(Just name)@ branch is observed to filter, not
-- just to mirror the @Nothing@ payload.
_ <- performBHRequest $ createIndexAlias testIndex otherAName create
performBHRequest $
getIndexAlias testIndex (Just (indexAliasNameToAliasName aName))
let found = indexAlias . indexAliasSummaryAlias <$> summs
liftIO $ do
aName `shouldSatisfy` (`elem` found)
-- The other alias must NOT appear: proves the filter
-- narrowed to the requested name.
otherAName `shouldNotSatisfy` (`elem` found)
)
`finally` withTestEnv
( do
_ <- tryEsError $ performBHRequest $ deleteIndexAlias aName
_ <- tryEsError $ performBHRequest $ deleteIndexAlias otherAName
pure ()
)
it "GET /{index}/_alias (getIndexAlias Nothing) lists every alias on the index" $
let otherAName = IndexAliasName [qqIndexName|bloodhound-tests-get-index-alias-list-other|]
otherAlias = IndexAlias testIndex otherAName
in ( do
IndexAliasesInfo summs <-
withTestEnv $ do
resetIndex
_ <- performBHRequest $ createIndexAlias testIndex aName create
_ <- performBHRequest $ createIndexAlias testIndex otherAName create
performBHRequest $ getIndexAlias testIndex Nothing
let names = indexAlias . indexAliasSummaryAlias <$> summs
liftIO $ do
aName `shouldSatisfy` (`elem` names)
otherAName `shouldSatisfy` (`elem` names)
)
`finally` withTestEnv
( do
_ <- tryEsError $ performBHRequest $ deleteIndexAlias aName
_ <- tryEsError $ performBHRequest $ deleteIndexAlias otherAName
pure ()
)
it "getIndexAlias surfaces 404 as EsError when the named alias is absent" $ do
result <-
withTestEnv $
tryEsError
( performBHRequest $
getIndexAlias
testIndex
(Just (AliasName [qqIndexName|bloodhound-tests-no-such-alias|]))
)
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing alias, got success"
it "getIndexAlias surfaces 404 as EsError when the index is absent" $ do
result <-
withTestEnv $
tryEsError
( performBHRequest $
getIndexAlias
[qqIndexName|bloodhound-no-such-index-04f-2-18-3|]
(Just (AliasName [qqIndexName|bloodhound-tests-no-such-alias|]))
)
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "Index Listing" $ do
it "returns a list of index names" $
withTestEnv $ do
_ <- createExampleIndex
ixns <- performBHRequest listIndices
liftIO (ixns `shouldContain` [testIndex])
describe "Index Settings" $ do
it "persists settings" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = BlocksWrite False :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [BlocksWrite False]
it "allows total fields to be set" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = MappingTotalFieldsLimit 2500 :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [MappingTotalFieldsLimit 2500]
it "allows unassigned.node_left.delayed_timeout to be set" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = UnassignedNodeLeftDelayedTimeout 10 :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [UnassignedNodeLeftDelayedTimeout 10]
it "accepts customer analyzers" $
withTestEnv $ do
_ <- deleteExampleIndex
let analysis =
Analysis
( M.singleton
"ex_analyzer"
( AnalyzerDefinition
(Just (Tokenizer "ex_tokenizer"))
( map
TokenFilter
[ "ex_filter_lowercase",
"ex_filter_uppercase",
"ex_filter_apostrophe",
"ex_filter_reverse",
"ex_filter_snowball",
"ex_filter_shingle"
]
)
( map
CharFilter
["html_strip", "ex_mapping", "ex_pattern_replace"]
)
)
)
( M.singleton
"ex_tokenizer"
( TokenizerDefinitionNgram
(Ngram 3 4 [TokenLetter, TokenDigit])
)
)
( M.fromList
[ ("ex_filter_lowercase", TokenFilterDefinitionLowercase (Just Greek)),
("ex_filter_uppercase", TokenFilterDefinitionUppercase Nothing),
("ex_filter_apostrophe", TokenFilterDefinitionApostrophe),
("ex_filter_reverse", TokenFilterDefinitionReverse),
("ex_filter_snowball", TokenFilterDefinitionSnowball English),
("ex_filter_shingle", TokenFilterDefinitionShingle (Shingle 3 3 True False " " "_")),
("ex_filter_stemmer", TokenFilterDefinitionStemmer German),
("ex_filter_stop1", TokenFilterDefinitionStop (Left French)),
( "ex_filter_stop2",
TokenFilterDefinitionStop
( Right $
map StopWord ["a", "is", "the"]
)
)
]
)
( M.fromList
[ ("ex_mapping", CharFilterDefinitionMapping (M.singleton "١" "1")),
("ex_pattern_replace", CharFilterDefinitionPatternReplace "(\\d+)-(?=\\d)" "$1_" Nothing)
]
)
updates = [AnalysisSetting analysis]
(createResp, _) <- performBHRequest $ keepBHResponse $ createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
liftIO $ validateStatus createResp 200
checkHasSettings updates
it "accepts default compression codec" $
withTestEnv $ do
_ <- deleteExampleIndex
let updates = [CompressionSetting CompressionDefault]
(createResp, _) <- performBHRequest $ keepBHResponse $ createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
liftIO $ validateStatus createResp 200
checkHasSettings updates
it "accepts best compression codec" $
withTestEnv $ do
_ <- deleteExampleIndex
let updates = [CompressionSetting CompressionBest]
(createResp, _) <- performBHRequest $ keepBHResponse $ createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
liftIO $ validateStatus createResp 200
checkHasSettings updates
it "updateIndexSettingsWith accepts master_timeout and preserve_existing" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let opts =
defaultUpdateIndexSettingsOptions
{ uisoMasterTimeout = Just (TimeUnitSeconds, 30),
uisoPreserveExisting = Just True
}
updates = BlocksWrite False :| []
(updateResp, _) <-
performBHRequest $
keepBHResponse $
updateIndexSettingsWith updates testIndex opts
liftIO $ validateStatus updateResp 200
checkHasSettings [BlocksWrite False]
it "updateIndexSettingsWith with defaultUpdateIndexSettingsOptions matches updateIndexSettings" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = BlocksWrite False :| []
(updateResp, _) <-
performBHRequest $
keepBHResponse $
updateIndexSettingsWith updates testIndex defaultUpdateIndexSettingsOptions
liftIO $ validateStatus updateResp 200
checkHasSettings [BlocksWrite False]
it "getIndexSettingsWith accepts include_defaults and parses the response" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let opts =
defaultGetIndexSettingsOptions
{ gisoIncludeDefaults = Just True
}
-- Discard all fields: this test only asserts that the response
-- (with include_defaults=true) decodes successfully.
IndexSettingsSummary _ _ _ <- performBHRequest $ getIndexSettingsWith testIndex opts
pure ()
it "getIndexSettingsWith with defaultGetIndexSettingsOptions matches getIndexSettings" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
IndexSettingsSummary _ _ a <- performBHRequest $ getIndexSettings testIndex
IndexSettingsSummary _ _ b <- performBHRequest $ getIndexSettingsWith testIndex defaultGetIndexSettingsOptions
liftIO $ a `shouldBe` b
-- Verifies a dynamic per-index setting from the modern set added in
-- bloodhound-04f.7.14 round-trips through the Index API. index.priority
-- is chosen because it is documented as dynamic and accepted by all ES
-- versions Bloodhound supports.
it "accepts index.priority" $
withTestEnv $ do
_ <- deleteExampleIndex
let updates = [IndexPriority 5]
(createResp, _) <- performBHRequest $ keepBHResponse $ createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
liftIO $ validateStatus createResp 200
checkHasSettings updates
-- Verifies a search-slowlog threshold from the modern set added in
-- bloodhound-04f.7.14 round-trips through the Index API. Uses the
-- query-phase path (ES splits the search slowlog into query/fetch
-- phases). Slowlog thresholds are dynamic since ES 7.x.
it "accepts index.search.slowlog.threshold.query.warn" $
withTestEnv $ do
_ <- deleteExampleIndex
let updates = [SearchSlowlogThresholdQueryWarn (EsDuration 10 TimeUnitSeconds)]
(createResp, _) <- performBHRequest $ keepBHResponse $ createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
liftIO $ validateStatus createResp 200
checkHasSettings updates
-- ------------------------------------------------------------------ --
-- Modern dynamic settings (bloodhound-04f.7.14) --
-- Each is set via PUT /{index}/_settings and read back with --
-- GET /{index}/_settings. ES returns leaf values as strings; the --
-- 'unStringlyTypeJSON' fallback in the 'FromJSON' parser handles --
-- the Bool/Int round-trip transparently. --
-- ------------------------------------------------------------------ --
describe "Index Settings (modern dynamic settings)" $ do
it "persists index.search.idle.after" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = IndexSearchIdleAfter (EsDuration 60 TimeUnitSeconds) :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [IndexSearchIdleAfter (EsDuration 60 TimeUnitSeconds)]
it "persists index.requests.cache.enable" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = RequestsCacheEnable True :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [RequestsCacheEnable True]
it "persists index.priority" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = IndexPriority 42 :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [IndexPriority 42]
it "persists index.hidden" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let updates = IndexHidden True :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [IndexHidden True]
it "persists a search slowlog threshold (query.warn = 200ms)" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let setting = SearchSlowlogThresholdQueryWarn (EsDuration 200 TimeUnitMilliseconds)
updates = setting :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [setting]
it "persists an indexing slowlog threshold (index.info = 1s)" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let setting = IndexingSlowlogThresholdIndexInfo (EsDuration 1 TimeUnitSeconds)
updates = setting :| []
(updateResp, _) <- performBHRequest $ keepBHResponse $ updateIndexSettings updates testIndex
liftIO $ validateStatus updateResp 200
checkHasSettings [setting]
describe "Index Settings (modern constructors, pure JSON round-trip)" $ do
-- Pure encode/decode pinning the exact wire shape — exercised for
-- every constructor via propApproxJSON in Test/JSONSpec.hs; these
-- 'it' cases lock representative wire paths so a path rename is
-- caught as a readable failure, not a QuickCheck shrink-sequence.
let encEq :: (ToJSON a) => a -> BL8.ByteString -> Expectation
encEq x expected = encode x `shouldBe` expected
decRoundTrip :: (Eq a, Show a, FromJSON a, ToJSON a) => a -> Expectation
decRoundTrip x = decode (encode x) `shouldBe` Just x
it "encodes IndexPriority at index.priority" $
encEq (IndexPriority 42) "{\"index\":{\"priority\":42}}"
it "round-trips IndexPriority" $ decRoundTrip (IndexPriority 42)
it "encodes IndexHidden at index.hidden" $
encEq (IndexHidden True) "{\"index\":{\"hidden\":true}}"
it "round-trips IndexHidden" $ decRoundTrip (IndexHidden True)
it "encodes RequestsCacheEnable at index.requests.cache.enable" $
encEq (RequestsCacheEnable True) "{\"index\":{\"requests\":{\"cache\":{\"enable\":true}}}}"
it "round-trips RequestsCacheEnable" $ decRoundTrip (RequestsCacheEnable True)
it "encodes BlocksReadOnlyAllowDelete at index.blocks.read_only_allow_delete" $
encEq (BlocksReadOnlyAllowDelete True) "{\"index\":{\"blocks\":{\"read_only_allow_delete\":true}}}"
it "round-trips BlocksReadOnlyAllowDelete" $ decRoundTrip (BlocksReadOnlyAllowDelete True)
-- Pins the bloodhound-442 fix: the four sibling Blocks* renderers
-- emit the same index.blocks.X form. Without these goldens a path
-- rename would surface only as a QuickCheck shrink-sequence, not
-- a readable failure (cf. the comment opening this describe block).
it "encodes BlocksReadOnly at index.blocks.read_only" $
encEq (BlocksReadOnly True) "{\"index\":{\"blocks\":{\"read_only\":true}}}"
it "round-trips BlocksReadOnly" $ decRoundTrip (BlocksReadOnly True)
it "encodes BlocksRead at index.blocks.read" $
encEq (BlocksRead True) "{\"index\":{\"blocks\":{\"read\":true}}}"
it "round-trips BlocksRead" $ decRoundTrip (BlocksRead True)
it "encodes BlocksWrite at index.blocks.write" $
encEq (BlocksWrite True) "{\"index\":{\"blocks\":{\"write\":true}}}"
it "round-trips BlocksWrite" $ decRoundTrip (BlocksWrite True)
it "encodes BlocksMetaData at index.blocks.metadata" $
encEq (BlocksMetaData True) "{\"index\":{\"blocks\":{\"metadata\":true}}}"
it "round-trips BlocksMetaData" $ decRoundTrip (BlocksMetaData True)
it "encodes IndexSearchIdleAfter with a string duration at index.search.idle.after" $
encEq
(IndexSearchIdleAfter (EsDuration 30 TimeUnitSeconds))
"{\"index\":{\"search\":{\"idle\":{\"after\":\"30s\"}}}}"
it "round-trips IndexSearchIdleAfter" $
decRoundTrip (IndexSearchIdleAfter (EsDuration 30 TimeUnitSeconds))
it "encodes a percent disk watermark at the low water mark" $
encEq
(RoutingAllocationDiskWatermarkLow (DiskWatermarkPercent 85))
"{\"index\":{\"routing\":{\"allocation\":{\"disk\":{\"watermark\":{\"low\":\"85.0%\"}}}}}}"
it "encodes a byte disk watermark at the high water mark" $
encEq
(RoutingAllocationDiskWatermarkHigh (DiskWatermarkBytes (Bytes 5000)))
"{\"index\":{\"routing\":{\"allocation\":{\"disk\":{\"watermark\":{\"high\":\"5000b\"}}}}}}"
it "round-trips both disk watermark forms" $ do
decRoundTrip (RoutingAllocationDiskWatermarkFloodStage (DiskWatermarkPercent 95))
decRoundTrip (RoutingAllocationDiskWatermarkFloodStage (DiskWatermarkBytes (Bytes 1024)))
it "encodes a search slowlog threshold at the deep query.warn path" $
encEq
(SearchSlowlogThresholdQueryWarn (EsDuration 200 TimeUnitMilliseconds))
"{\"index\":{\"search\":{\"slowlog\":{\"threshold\":{\"query\":{\"warn\":\"200ms\"}}}}}}"
it "encodes an indexing slowlog threshold at the deep index.info path" $
encEq
(IndexingSlowlogThresholdIndexInfo (EsDuration 5 TimeUnitSeconds))
"{\"index\":{\"indexing\":{\"slowlog\":{\"threshold\":{\"index\":{\"info\":\"5s\"}}}}}}"
it "decodes the search slowlog threshold from the wire path" $
decode
"{\"index\":{\"search\":{\"slowlog\":{\"threshold\":{\"fetch\":{\"trace\":\"500ms\"}}}}}}"
`shouldBe` Just (SearchSlowlogThresholdFetchTrace (EsDuration 500 TimeUnitMilliseconds))
it "round-trips every slowlog threshold constructor" $ do
decRoundTrip (SearchSlowlogThresholdQueryWarn (EsDuration 1 TimeUnitMilliseconds))
decRoundTrip (SearchSlowlogThresholdFetchInfo (EsDuration 2 TimeUnitSeconds))
decRoundTrip (IndexingSlowlogThresholdIndexDebug (EsDuration 3 TimeUnitMilliseconds))
-- Disk watermarks are NOT exercised by a live integration test:
-- @index.routing.allocation.disk.watermark.*@ can be refused by the
-- per-index @/_settings@ API on some backends (they are
-- cluster-level allocation settings). The constructors are
-- round-tripped purely above and covered by propApproxJSON.
describe "Compression codec (pure)" $ do
-- CompressionDefault / CompressionBest are exercised by the live
-- "Index Settings" block above; CompressionZstd is unit-only because
-- the ES test backend does not accept it (zstd is OpenSearch-native).
it "encodes default/best/zstd" $ do
encode CompressionDefault `shouldBe` "\"default\""
encode CompressionBest `shouldBe` "\"best_compression\""
encode CompressionZstd `shouldBe` "\"zstd\""
it "decodes all three codec names" $ do
decode "\"default\"" `shouldBe` Just CompressionDefault
decode "\"best_compression\"" `shouldBe` Just CompressionBest
decode "\"zstd\"" `shouldBe` Just CompressionZstd
it "rejects an unknown codec" $
(decode "\"lz4\"" :: Maybe Compression) `shouldBe` Nothing
describe "EsDuration / DiskWatermark (pure)" $ do
it "renders every TimeUnits suffix" $ do
renderEsDuration (EsDuration 5 TimeUnitMilliseconds) `shouldBe` "5ms"
renderEsDuration (EsDuration 5 TimeUnitMicroseconds) `shouldBe` "5micros"
renderEsDuration (EsDuration 5 TimeUnitNanoseconds) `shouldBe` "5nanos"
renderEsDuration (EsDuration 5 TimeUnitSeconds) `shouldBe` "5s"
it "parses ms before s (200ms is milliseconds, not 200m+s)" $
decode "\"200ms\"" `shouldBe` Just (EsDuration 200 TimeUnitMilliseconds)
it "parses bare seconds" $
decode "\"5s\"" `shouldBe` Just (EsDuration 5 TimeUnitSeconds)
it "parses a percent watermark" $
decode "\"85%\"" `shouldBe` Just (DiskWatermarkPercent 85)
it "parses a byte-size watermark (gb)" $
decode "\"500gb\"" `shouldBe` Just (DiskWatermarkBytes (Bytes 500000000000))
it "parses a bare-bytes watermark (b suffix)" $
decode "\"1024b\"" `shouldBe` Just (DiskWatermarkBytes (Bytes 1024))
it "rejects an unparseable duration" $
(decode "\"abc\"" :: Maybe EsDuration) `shouldBe` Nothing
describe "GET /{index} (getIndex)" $ do
it "returns the requested index name, settings and mappings" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
info <- performBHRequest $ getIndex testIndex
liftIO $ do
iiIndexName info `shouldBe` testIndex
-- putMapping in resetIndex uses ShardCount 1 / ReplicaCount 0
-- (see TestsUtils.Common.createExampleIndex).
indexShards (iiFixedSettings info) `shouldBe` ShardCount 1
indexReplicas (iiFixedSettings info) `shouldBe` ReplicaCount 0
-- mappings block should be present and an object, not Null
case iiMappings info of
Object _ -> pure ()
other -> expectationFailure $ "expected mappings object, got " <> show other
-- NumberOfReplicas is filtered out of the updateable list
-- because it is already carried by iiFixedSettings.indexReplicas.
hasNumberOfReplicas (iiUpdateableSettings info) `shouldBe` False
it "returns an empty aliases list for a fresh index" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
info <- performBHRequest $ getIndex testIndex
liftIO $ iiAliases info `shouldBe` []
it "includes aliases added via updateIndexAliases" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let aName = IndexAliasName [qqIndexName|bloodhound-tests-getindex-alias|]
let alias = IndexAlias testIndex aName
let create = defaultIndexAliasCreate
_ <- performBHRequest $ keepBHResponse $ updateIndexAliases (AddAlias alias create :| [])
info <- performBHRequest $ getIndex testIndex
liftIO $ do
length (iiAliases info) `shouldBe` 1
let summary = case iiAliases info of
(s : _) -> Just s
[] -> Nothing
(indexAliasSummaryAlias <$> summary) `shouldBe` Just alias
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getIndex [qqIndexName|bloodhound-no-such-index-04f-2-1|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "GET /{index}/_mapping (getMapping)" $ do
it "round-trips a mapping installed with putMapping" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
mapping <- performBHRequest $ getMapping @Value testIndex
case extractMessageType mapping of
Right t -> liftIO $ t `shouldBe` "text"
Left e -> liftIO $ expectationFailure $ "getMapping response did not decode: " <> e
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getMapping @Value [qqIndexName|bloodhound-no-such-index-04f-2-2|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "GET /{index}/_mapping/field/{fields} (getFieldMapping)" $ do
it "returns the type of a single requested field" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
mapping <- performBHRequest $ getFieldMapping @Value testIndex [FieldName "message"]
case extractFieldMappingType "message" mapping of
Right t -> liftIO $ t `shouldBe` "text"
Left e -> liftIO $ expectationFailure $ "getFieldMapping response did not decode: " <> e
it "decodes multiple requested fields" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
mapping <-
performBHRequest $
getFieldMapping
@Value
testIndex
[FieldName "user", FieldName "age"]
case (extractFieldMappingType "user" mapping, extractFieldMappingType "age" mapping) of
(Right tu, Right ta) -> liftIO $ do
tu `shouldBe` "text"
ta `shouldBe` "integer"
(Left e, _) -> liftIO $ expectationFailure $ "user field not decoded: " <> e
(_, Left e) -> liftIO $ expectationFailure $ "age field not decoded: " <> e
it "decodes into the typed FieldMappingResponse" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
resp <- performBHRequest $ getFieldMapping @FieldMappingResponse testIndex [FieldName "message"]
case M.lookup testIndex (fieldMappingResponseIndices resp) of
Nothing -> liftIO $ expectationFailure "expected an entry for the test index"
Just entry -> case M.lookup "message" (fieldMappingIndexEntryFields entry) of
Nothing -> liftIO $ expectationFailure "expected a 'message' field entry"
Just detail ->
liftIO $ fieldMappingDetailFullName detail `shouldBe` "message"
it "expands wildcards and returns every matching field" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
resp <- performBHRequest $ getFieldMapping @FieldMappingResponse testIndex [FieldName "*"]
case M.lookup testIndex (fieldMappingResponseIndices resp) of
Nothing -> liftIO $ expectationFailure "expected an entry for the test index"
Just entry ->
liftIO $
M.member "message" (fieldMappingIndexEntryFields entry)
`shouldBe` True
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError
( performBHRequest $
getFieldMapping
@Value
[qqIndexName|bloodhound-no-such-index-04f-2-3|]
[FieldName "message"]
)
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "Index Optimization" $ do
it "returns a successful response upon completion" $
withTestEnv $ do
_ <- createExampleIndex
(resp, _) <- performBHRequest $ keepBHResponse $ forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
liftIO $ validateStatus resp 200
describe "Index flushing" $ do
it "returns a successful response upon flushing" $
withTestEnv $ do
_ <- createExampleIndex
(resp, _) <- performBHRequest $ keepBHResponse $ flushIndex testIndex
liftIO $ validateStatus resp 200
-- Regression guard for bloodhound-04f.2.19: flushIndex used to be
-- typed as 'BHRequest StatusDependant ShardResult', but the real
-- ES/OS response is the @_shards@ envelope. The old 'ShardResult'
-- parser silently decoded every field to 0, hiding real shard
-- counts. Asserting @shardTotal >= 1@ here is the minimum check
-- that catches the silent-zero regression on a live cluster.
it "parses the {_shards: ...} envelope from _flush" $
withTestEnv $ do
_ <- createExampleIndex
ShardsResult shardResult <- performBHRequest $ flushIndex testIndex
liftIO $ do
shardTotal shardResult `shouldSatisfy` (>= 1)
shardsFailed shardResult `shouldBe` 0
-- Mirror of the _flush guard above for 'refreshIndex'. Same parser
-- (@FromJSON ShardsResult@), same envelope shape, separate endpoint
-- so a regression on either path surfaces independently.
it "parses the {_shards: ...} envelope from _refresh" $
withTestEnv $ do
_ <- createExampleIndex
ShardsResult shardResult <- performBHRequest $ refreshIndex testIndex
liftIO $ do
shardTotal shardResult `shouldSatisfy` (>= 1)
shardsFailed shardResult `shouldBe` 0
-- Pure unit test (no ES round-trip): locks the 'FromJSON ShardsResult'
-- decoder against the actual wire shape returned by
-- @POST /<index>/_flush@ and @POST /<index>/_refresh@, so the
-- silent-zero regression cannot sneak back in without a test failure
-- even when no cluster is reachable.
it "FromJSON ShardsResult decodes the {_shards: ...} envelope from _flush/_refresh" $ do
let payload = BL8.pack "{\"_shards\":{\"total\":2,\"successful\":2,\"skipped\":0,\"failed\":0}}"
decoded = decode payload :: Maybe ShardsResult
decoded `shouldBe` Just (ShardsResult (ShardResult 2 2 0 0))
describe "Index cache clearing" $ do
it "returns a successful response upon clearing the cache" $
withTestEnv $ do
_ <- createExampleIndex
(resp, _) <- performBHRequest $ keepBHResponse $ clearIndexCache testIndex
liftIO $ validateStatus resp 200
it "parses the {_shards: ...} envelope into ShardsResult" $
withTestEnv $ do
_ <- createExampleIndex
ShardsResult shardResult <- performBHRequest $ clearIndexCache testIndex
liftIO $ shardsSuccessful shardResult `shouldSatisfy` (>= 0)
-- ------------------------------------------------------------------ --
-- createIndexOptions: body fields + URI params (bloodhound-04f.7.11) --
-- ------------------------------------------------------------------ --
describe "createIndexOptions URI param rendering" $ do
-- Pure unit tests (no ES required) — modelled after
-- Test/SearchOptionsSpec.hs.
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultCreateIndexOptions emits no params" $
createIndexOptionsParams defaultCreateIndexOptions
`shouldBe` []
it "renders AllActiveShards as \"all\"" $ do
let opts = defaultCreateIndexOptions {cioWaitForActiveShards = Just AllActiveShards}
createIndexOptionsParams opts
`shouldBe` [("wait_for_active_shards", Just "all")]
it "renders ActiveShards as the bare decimal" $ do
let opts = defaultCreateIndexOptions {cioWaitForActiveShards = Just (ActiveShards 3)}
createIndexOptionsParams opts
`shouldBe` [("wait_for_active_shards", Just "3")]
it "renders master_timeout and timeout as <n><suffix>" $ do
let opts =
defaultCreateIndexOptions
{ cioMasterTimeout = Just (TimeUnitSeconds, 30),
cioTimeout = Just (TimeUnitMilliseconds, 500)
}
normalize (createIndexOptionsParams opts)
`shouldBe` [ ("master_timeout", Just "30s"),
("timeout", Just "500ms")
]
it "emits every param together when all are set" $ do
let opts =
defaultCreateIndexOptions
{ cioWaitForActiveShards = Just AllActiveShards,
cioMasterTimeout = Just (TimeUnitMinutes, 1),
cioTimeout = Just (TimeUnitSeconds, 10)
}
normalize (createIndexOptionsParams opts)
`shouldBe` [ ("master_timeout", Just "1m"),
("timeout", Just "10s"),
("wait_for_active_shards", Just "all")
]
describe "createIndexOptions body rendering" $ do
-- Pure unit tests for the body builder. We compare decoded JSON
-- (not raw bytes) because 'deepMerge' does not guarantee key order.
let decodedKeys :: Maybe Value -> Maybe [T.Text]
decodedKeys (Just (Object o)) = Just (L.sort (toText <$> KM.keys o))
decodedKeys _ = Nothing
it "defaultCreateIndexOptions produces no body" $
createIndexOptionsBody defaultCreateIndexOptions
`shouldBe` Nothing
it "cioSettings alone matches the legacy createIndex body" $ do
let settings = IndexSettings (ShardCount 1) (ReplicaCount 0) defaultIndexMappingsLimits
let opts = defaultCreateIndexOptions {cioSettings = Just settings}
createIndexOptionsBody opts
`shouldBe` Just (encode settings)
it "cioMappings alone produces a body with only the mappings key" $ do
let mapping = object ["properties" .= object ["user" .= object ["type" .= ("keyword" :: T.Text)]]]
let opts = defaultCreateIndexOptions {cioMappings = Just mapping}
decodedKeys (decode =<< createIndexOptionsBody opts)
`shouldBe` Just ["mappings"]
it "cioAliases alone produces a body with only the aliases key" $ do
let aliases = KM.singleton "bloodhound-tests-twitter-1-alias" (object [])
let opts = defaultCreateIndexOptions {cioAliases = Just aliases}
decodedKeys (decode =<< createIndexOptionsBody opts)
`shouldBe` Just ["aliases"]
it "merges settings + mappings + aliases into one object" $ do
let settings = IndexSettings (ShardCount 1) (ReplicaCount 0) defaultIndexMappingsLimits
let mapping = object ["properties" .= object []]
let aliases = KM.singleton "alias1" (object [])
let opts =
defaultCreateIndexOptions
{ cioSettings = Just settings,
cioMappings = Just mapping,
cioAliases = Just aliases
}
decodedKeys (decode =<< createIndexOptionsBody opts)
`shouldBe` Just ["aliases", "mappings", "settings"]
describe "createIndexOptions integration" $ do
-- Live integration coverage: verify the new endpoint variants are
-- accepted by a real backend. Each case tears the index down first
-- so that createIndexOptions is the call that actually creates it.
let resetIndexOpts opts = withTestEnv $ do
_ <- tryEsError deleteExampleIndex
(resp, _) <- performBHRequest $ keepBHResponse $ createIndexOptions opts testIndex
pure (resp :: BHResponse StatusDependant Acknowledged, ())
it "succeeds with only cioSettings (default-equivalent to createIndex)" $ do
let opts = defaultCreateIndexOptions {cioSettings = Just defaultIndexSettings}
(resp, _) <- resetIndexOpts opts
liftIO $ validateStatus resp 200
it "accepts cioMappings (properties block)" $ do
let mapping = object ["properties" .= object ["user" .= object ["type" .= ("keyword" :: T.Text)]]]
let opts =
defaultCreateIndexOptions
{ cioSettings = Just defaultIndexSettings,
cioMappings = Just mapping
}
(resp, _) <- resetIndexOpts opts
liftIO $ validateStatus resp 200
it "accepts cioAliases (alias defined at create time)" $ do
let aliases = KM.singleton "bloodhound-tests-create-options-alias" (object [])
let opts =
defaultCreateIndexOptions
{ cioSettings = Just defaultIndexSettings,
cioAliases = Just aliases
}
(resp, _) <- resetIndexOpts opts
liftIO $ validateStatus resp 200
it "accepts cioWaitForActiveShards = AllActiveShards" $ do
-- defaultIndexSettings sets 2 replicas, but a single-node test
-- cluster cannot allocate them, so @wait_for_active_shards=all@
-- would block until the request times out. Use ReplicaCount 0
-- so every shard copy is on the single available node.
let settings = IndexSettings (ShardCount 1) (ReplicaCount 0) defaultIndexMappingsLimits
let opts =
defaultCreateIndexOptions
{ cioSettings = Just settings,
cioWaitForActiveShards = Just AllActiveShards
}
(resp, _) <- resetIndexOpts opts
liftIO $ validateStatus resp 200
it "accepts cioTimeout" $ do
let opts =
defaultCreateIndexOptions
{ cioSettings = Just defaultIndexSettings,
cioTimeout = Just (TimeUnitSeconds, 5)
}
(resp, _) <- resetIndexOpts opts
liftIO $ validateStatus resp 200
describe "GET /{index}/_stats (getIndexStats)" $ do
it "returns stats for the requested index with typed docs and store" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
_ <- performBHRequest $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
_ <- performBHRequest $ refreshIndex testIndex
stats <- performBHRequest $ getIndexStats testIndex
liftIO $ shardsSuccessful (indexStatsShards stats) `shouldSatisfy` (>= 1)
case M.lookup testIndex (indexStatsIndices stats) of
Nothing -> liftIO $ expectationFailure "expected an entry for the test index"
Just entry -> do
let primaries = indexStatEntryPrimaries entry
case indexStatMetricsDocs primaries of
Nothing -> liftIO $ expectationFailure "expected primaries.docs to be present"
Just d -> liftIO $ indexStatDocsCount d `shouldSatisfy` (>= 1)
case indexStatMetricsStore (indexStatEntryTotal entry) of
Nothing -> liftIO $ expectationFailure "expected total.store to be present"
Just s -> liftIO $ indexStatStoreSizeInBytes s `shouldSatisfy` (>= 1)
-- The "other" blob must preserve the raw metrics object so
-- callers can navigate indexing/search/merge/etc. sections
-- that are not yet typed.
case indexStatMetricsOther primaries of
Object _ -> pure ()
other -> liftIO $ expectationFailure $ "expected metrics object, got " <> show other
it "exposes _shards and the index entry even on a fresh index" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
stats <- performBHRequest $ getIndexStats testIndex
liftIO $ M.member testIndex (indexStatsIndices stats) `shouldBe` True
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getIndexStats [qqIndexName|bloodhound-no-such-index-04f-2-8|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "GET /{index}/_recovery (getIndexRecovery)" $ do
it "returns recovery info for the requested index with typed shard entries" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
_ <- performBHRequest $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
_ <- performBHRequest $ refreshIndex testIndex
recovery <- performBHRequest $ getIndexRecovery testIndex
-- The endpoint is scoped to a single index; only that key
-- should appear in the response.
liftIO $ M.keys (indexRecoveryIndices recovery) `shouldBe` [testIndex]
case M.lookup testIndex (indexRecoveryIndices recovery) of
Nothing -> liftIO $ expectationFailure "expected an entry for the test index"
Just (s : _) -> do
liftIO $ shardRecoveryId s `shouldSatisfy` (>= 0)
liftIO $ shardRecoveryPrimary s `shouldBe` True
-- Once refreshIndex returns, every recovery has settled to
-- DONE for an already-green primary shard.
liftIO $ shardRecoveryStage s `shouldBe` Just "DONE"
case shardRecoveryIndex s of
Nothing -> liftIO $ expectationFailure "expected an index block on the shard"
Just idxBlock -> do
-- The verbatim "Other" blob must preserve the raw
-- @index@ object so callers can navigate not-yet-typed
-- sections (size, translog, verify_index, ...).
case shardRecoveryIndexOther idxBlock of
Object _ -> pure ()
other ->
liftIO $
expectationFailure $
"expected index block to be an object, got " <> show other
case shardRecoveryIndexFiles idxBlock of
Nothing -> liftIO $ expectationFailure "expected a files block on the index"
Just files -> liftIO $ do
-- Whatever was recovered equals the total file count
-- (trivially 0 == 0 for an EMPTY_STORE primary on a
-- fresh local index, or N == N once DONE on a real
-- recovery).
shardRecoveryFilesTotal files `shouldBe` shardRecoveryFilesRecovered files
-- Percent is always present and well-formed.
case shardRecoveryFilesPercent files of
Just p -> T.isSuffixOf "%" p `shouldBe` True
Nothing -> expectationFailure "expected a percent value"
Just [] -> liftIO $ expectationFailure "expected at least one shard entry"
it "preserves the raw shard object verbatim in shardRecoveryOther" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
recovery <- performBHRequest $ getIndexRecovery testIndex
case M.lookup testIndex (indexRecoveryIndices recovery) of
Just (s : _) -> case shardRecoveryOther s of
Object _ -> pure ()
other ->
liftIO $
expectationFailure $
"expected shard other to be an object, got " <> show other
_ -> liftIO $ expectationFailure "expected at least one shard entry"
it "exposes the index entry even on a fresh empty index" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
recovery <- performBHRequest $ getIndexRecovery testIndex
liftIO $ M.member testIndex (indexRecoveryIndices recovery) `shouldBe` True
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getIndexRecovery [qqIndexName|bloodhound-no-such-index-04f-2-10|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "GET /{index}/_segments (getIndexSegments)" $ do
it "returns segment info for the requested index with typed core fields" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
_ <- performBHRequest $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
_ <- performBHRequest $ refreshIndex testIndex
segments <- performBHRequest $ getIndexSegments testIndex
liftIO $ shardsSuccessful (indexSegmentsShards segments) `shouldSatisfy` (>= 1)
case M.lookup testIndex (indexSegmentsIndices segments) of
Nothing -> liftIO $ expectationFailure "expected an entry for the test index"
Just shardsMap -> case firstShardCopy shardsMap of
Nothing -> liftIO $ expectationFailure "expected at least one shard copy"
Just shardCopy -> do
liftIO $ segmentRoutingPrimary (indexSegmentsShardRouting shardCopy) `shouldBe` True
case firstSegment shardCopy of
Nothing -> liftIO $ expectationFailure "expected at least one segment after indexing a document"
Just seg -> liftIO $ do
segmentNumDocs seg `shouldSatisfy` (>= 1)
segmentSizeInBytes seg `shouldSatisfy` (>= 1)
segmentGeneration seg `shouldSatisfy` (>= 0)
segmentDeletedDocs seg `shouldSatisfy` (>= 0)
-- version is always populated once a segment exists
case segmentVersion seg of
Nothing -> expectationFailure "expected a segment version"
Just _ -> pure ()
it "exposes _shards and the index entry even on a fresh empty index" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
segments <- performBHRequest $ getIndexSegments testIndex
liftIO $ do
shardTotal (indexSegmentsShards segments) `shouldSatisfy` (>= 1)
M.member testIndex (indexSegmentsIndices segments) `shouldBe` True
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getIndexSegments [qqIndexName|bloodhound-no-such-index-04f-2-9|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
it "SegmentInfo preserves non-promoted keys in segmentOther" $ do
-- ES 8+/9+ add fields like lucene_version, segment_sort,
-- vector_dimension that the typed SegmentInfo does not (yet)
-- promote. This pure unit test pins the knownKeys filter so a
-- future field addition cannot silently drop them.
let blob =
object
[ "generation" .= Number 0,
"num_docs" .= Number 1,
"deleted_docs" .= Number 0,
"size_in_bytes" .= Number 4278,
"memory_in_bytes" .= Number 1428,
"committed" .= Bool False,
"search" .= Bool True,
"version" .= String "8.11.3",
"compound" .= Bool True,
"attributes" .= object ["Lucene87StoredFieldsFormat.mode" .= String "BEST_SPEED"],
-- exotic / future fields:
"lucene_version" .= String "9.0.0",
"segment_sort" .= String "doc",
"vector_dimension" .= Number 768
]
case eitherDecode (encode blob) of
Right seg -> case segmentOther seg of
Just (Object km) -> do
length km `shouldBe` 3
KM.member "lucene_version" km `shouldBe` True
KM.member "segment_sort" km `shouldBe` True
KM.member "vector_dimension" km `shouldBe` True
other ->
expectationFailure $ "expected non-empty object, got " <> show other
Left err -> expectationFailure $ "decode failed: " <> err
describe "GET /{index}/_shard_stores (getShardStores)" $ do
-- Pure FromJSON unit tests exercise the dynamic node-id key shape
-- and the forward-compat paths that the integration tests below
-- can't reliably reach (the live server always emits the ES-rich
-- node metadata set and never returns `unavailable` on a green
-- single-node cluster).
describe "ShardStores FromJSON" $ do
let decodeStores = (decode :: BL8.ByteString -> Maybe ShardStores)
it "parses the canonical ES example with one primary store copy" $ do
let body =
BL8.pack
"{\"indices\":{\"my-index-000001\":{\"shards\":{\"0\":{\"stores\":[\
\{\"sPa3OgxLSYGvQ4oPs-Tajw\":{\"name\":\"node_t0\",\"ephemeral_id\":\"9NlXRFGCT1m8tkvYCMK-8A\",\"transport_address\":\"local[1]\",\"external_id\":\"node_t0\",\"attributes\":{},\"roles\":[],\"version\":\"8.10.0\",\"min_index_version\":7000099,\"max_index_version\":8100099},\"allocation_id\":\"2iNySv_OQVePRX-yaRH_lQ\",\"allocation\":\"primary\"}]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
case M.lookup [qqIndexName|my-index-000001|] (shardStoresIndices stores) of
Nothing -> expectationFailure "expected an entry for the index"
Just shardsMap -> case M.lookup "0" shardsMap of
Nothing -> expectationFailure "expected shard 0"
Just shard -> case shardStoresShardStores shard of
[copy] -> do
shardStoreAllocationId copy `shouldBe` Just "2iNySv_OQVePRX-yaRH_lQ"
shardStoreAllocation copy `shouldBe` Just ShardStoreAllocationPrimary
case shardStoreNode copy of
Just (nodeId, node) -> do
nodeId `shouldBe` "sPa3OgxLSYGvQ4oPs-Tajw"
shardStoreNodeName node `shouldBe` Just "node_t0"
shardStoreNodeTransportAddress node `shouldBe` Just "local[1]"
shardStoreNodeExternalId node `shouldBe` Just "node_t0"
shardStoreNodeRoles node `shouldBe` Just []
shardStoreNodeVersion node `shouldBe` Just "8.10.0"
shardStoreNodeMinIndexVersion node `shouldBe` Just 7000099
shardStoreNodeMaxIndexVersion node `shouldBe` Just 8100099
other ->
expectationFailure $ "expected node entry, got " <> show other
other ->
expectationFailure $ "expected exactly one store copy, got " <> show other
it "parses the OpenSearch (minimal) node metadata shape" $ do
let body =
BL8.pack
"{\"indices\":{\"logs-shardstore\":{\"shards\":{\"0\":{\"stores\":[\
\{\"UFyVYVMCSDOUbA1wPxSW5w\":{\"name\":\"opensearch-node1\",\"ephemeral_id\":\"vkSB_-M7QVyFXvgda6oRZg\",\"transport_address\":\"172.19.0.2:9300\",\"attributes\":{\"shard_indexing_pressure_enabled\":\"true\"}},\"allocation_id\":\"PEM5YjEWSz-jJEj-Not6Aw\",\"allocation\":\"replica\"}]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
case M.lookup [qqIndexName|logs-shardstore|] (shardStoresIndices stores) of
Just shardsMap -> case M.lookup "0" shardsMap of
Just shard -> case shardStoresShardStores shard of
[copy] -> case shardStoreNode copy of
Just (_, node) -> do
shardStoreNodeName node `shouldBe` Just "opensearch-node1"
shardStoreNodeExternalId node `shouldBe` Nothing
shardStoreNodeRoles node `shouldBe` Nothing
shardStoreNodeVersion node `shouldBe` Nothing
shardStoreNodeMinIndexVersion node `shouldBe` Nothing
shardStoreNodeAttributes node
`shouldBe` Just (M.fromList [("shard_indexing_pressure_enabled", "true")])
other ->
expectationFailure $ "expected node entry, got " <> show other
other ->
expectationFailure $ "expected one store copy, got " <> show other
Nothing -> expectationFailure "expected shard 0"
Nothing -> expectationFailure "expected an entry for the index"
it "parses an empty stores array (shard with no assigned copy)" $ do
let body = BL8.pack "{\"indices\":{\"ix\":{\"shards\":{\"1\":{\"stores\":[]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
case M.lookup [qqIndexName|ix|] (shardStoresIndices stores) of
Just shardsMap -> case M.lookup "1" shardsMap of
Just shard -> shardStoresShardStores shard `shouldBe` []
Nothing -> expectationFailure "expected shard 1"
Nothing -> expectationFailure "expected an entry for the index"
it "parses the unavailable allocation with a store_exception" $ do
let body =
BL8.pack
"{\"indices\":{\"ix\":{\"shards\":{\"0\":{\"stores\":[\
\{\"abc\":{\"name\":\"n\"},\"allocation_id\":\"id1\",\"allocation\":\"unavailable\",\"store_exception\":{\"type\":\"file_corrupt\",\"reason\":\"boom\"}}]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
case M.lookup [qqIndexName|ix|] (shardStoresIndices stores) of
Just shardsMap -> case M.lookup "0" shardsMap of
Just shard -> case shardStoresShardStores shard of
[copy] -> do
shardStoreAllocation copy `shouldBe` Just ShardStoreAllocationUnavailable
case shardStoreStoreException copy of
Just exc -> do
shardStoreExceptionType exc `shouldBe` Just "file_corrupt"
shardStoreExceptionReason exc `shouldBe` Just "boom"
Nothing -> expectationFailure "expected store_exception"
Nothing -> expectationFailure "expected shard 0"
Nothing -> expectationFailure "expected an entry for the index"
it "rejects payloads with multiple Object-valued node entries" $ do
let body =
BL8.pack
"{\"indices\":{\"ix\":{\"shards\":{\"0\":{\"stores\":[\
\{\"abc\":{\"name\":\"n\"},\"def\":{\"name\":\"m\"},\"allocation\":\"primary\"}]}}}}}"
case decodeStores body of
Just (_ :: ShardStores) ->
expectationFailure "expected decode to fail with multiple node entries"
Nothing -> pure ()
it "preserves unknown scalar sibling keys in shardStoreOther" $ do
-- Future scalar sibling fields (e.g. a hypothetical
-- `recovery_state`) survive round-trip in shardStoreOther
-- without breaking the node-id detection.
let body =
BL8.pack
"{\"indices\":{\"ix\":{\"shards\":{\"0\":{\"stores\":[\
\{\"abc\":{\"name\":\"n\"},\"allocation\":\"primary\",\
\\"recovery_state\":\"active\",\"priority\":42}]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
case M.lookup [qqIndexName|ix|] (shardStoresIndices stores) of
Just shardsMap -> case M.lookup "0" shardsMap of
Just shard -> case shardStoresShardStores shard of
[copy] -> do
-- node entry still detected alongside the new scalars
case shardStoreNode copy of
Just (nodeId, node) -> do
nodeId `shouldBe` "abc"
shardStoreNodeName node `shouldBe` Just "n"
Nothing -> expectationFailure "expected node entry"
-- unknown scalars captured verbatim
case shardStoreOther copy of
Just (Object km) -> do
length km `shouldBe` 2
KM.member "recovery_state" km `shouldBe` True
KM.member "priority" km `shouldBe` True
other ->
expectationFailure $ "expected non-empty object, got " <> show other
Nothing -> expectationFailure "expected shard 0"
Nothing -> expectationFailure "expected an entry for the index"
it "preserves non-promoted keys in shardStoreExceptionOther" $ do
let blob =
object
[ "type" .= String "file_corrupt",
"reason" .= String "boom",
-- exotic / future fields:
"stack_hash" .= String "0xdeadbeef",
"retryable" .= Bool False
]
case eitherDecode (encode blob) of
Right exc -> case shardStoreExceptionOther exc of
Just (Object km) -> do
length km `shouldBe` 2
KM.member "stack_hash" km `shouldBe` True
KM.member "retryable" km `shouldBe` True
other ->
expectationFailure $ "expected non-empty object, got " <> show other
Left err -> expectationFailure $ "decode failed: " <> err
it "preserves non-promoted keys in shardStoreNodeOther" $ do
-- Future / engine-specific node fields survive round-trip in
-- shardStoreNodeOther (mirrors segmentOther behaviour).
let blob =
object
[ "name" .= String "n",
"ephemeral_id" .= String "eid",
"transport_address" .= String "ta",
"external_id" .= String "eid2",
"attributes" .= object [],
"roles" .= ([] :: [Text]),
"version" .= String "9.0.0",
"min_index_version" .= Number 7,
"max_index_version" .= Number 9,
-- exotic / future fields:
"node_role" .= String "data_hot",
"build_type" .= String "docker"
]
case eitherDecode (encode blob) of
Right node -> case shardStoreNodeOther node of
Just (Object km) -> do
length km `shouldBe` 2
KM.member "node_role" km `shouldBe` True
KM.member "build_type" km `shouldBe` True
other ->
expectationFailure $ "expected non-empty object, got " <> show other
Left err -> expectationFailure $ "decode failed: " <> err
it "tolerates a missing _shards envelope (defensive parse)" $ do
let body = BL8.pack "{\"indices\":{\"ix\":{\"shards\":{\"0\":{\"stores\":[]}}}}}"
let Just (stores :: ShardStores) = decodeStores body
shardTotal (shardStoresShards stores) `shouldBe` 0
it "round-trips ShardStoresStatus through ToJSON/FromJSON" $ do
let roundTrip s = decode (encode s) :: Maybe ShardStoresStatus
roundTrip ShardStoresStatusGreen `shouldBe` Just ShardStoresStatusGreen
roundTrip ShardStoresStatusYellow `shouldBe` Just ShardStoresStatusYellow
roundTrip ShardStoresStatusRed `shouldBe` Just ShardStoresStatusRed
roundTrip ShardStoresStatusAll `shouldBe` Just ShardStoresStatusAll
it "round-trips ShardStoreAllocation through ToJSON/FromJSON" $ do
let roundTrip a = decode (encode a) :: Maybe ShardStoreAllocation
roundTrip ShardStoreAllocationPrimary `shouldBe` Just ShardStoreAllocationPrimary
roundTrip ShardStoreAllocationReplica `shouldBe` Just ShardStoreAllocationReplica
roundTrip ShardStoreAllocationUnavailable `shouldBe` Just ShardStoreAllocationUnavailable
roundTrip (ShardStoreAllocationOther "postprimary")
`shouldBe` Just (ShardStoreAllocationOther "postprimary")
it "shardStoresOptionsParams renders status as a comma-joined list" $ do
let opts =
defaultShardStoresOptions
{ ssoStatus = Just (ShardStoresStatusYellow :| [ShardStoresStatusRed])
}
shardStoresOptionsParams opts
`shouldContain` [("status", Just "yellow,red")]
it "defaultShardStoresOptions emits no query string" $ do
shardStoresOptionsParams defaultShardStoresOptions `shouldBe` []
it "returns store info for the requested index with typed allocation" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ putMapping @Value testIndex TweetMapping
_ <- performBHRequest $ indexDocument testIndex defaultIndexDocumentSettings exampleTweet (DocId "1")
_ <- performBHRequest $ refreshIndex testIndex
-- The server's default status filter is @yellow,red@ which
-- excludes healthy primaries on a green single-node cluster;
-- widen the filter to surface the test index's stores.
let allStatus = defaultShardStoresOptions {ssoStatus = Just (ShardStoresStatusAll :| [])}
stores <- performBHRequest $ getShardStoresWith testIndex allStatus
case M.lookup testIndex (shardStoresIndices stores) of
Nothing ->
liftIO $ expectationFailure "expected an entry for the test index"
Just shardsMap -> case firstShardStore shardsMap of
Nothing ->
liftIO $ expectationFailure "expected at least one store copy"
Just copy -> do
liftIO $ case shardStoreAllocation copy of
Just ShardStoreAllocationPrimary -> pure ()
other ->
expectationFailure $
"expected primary allocation on single-node cluster, got "
<> show other
case shardStoreNode copy of
Just (_, node) ->
liftIO $ case shardStoreNodeName node of
Nothing -> expectationFailure "expected a node name"
Just _ -> pure ()
Nothing ->
liftIO $ expectationFailure "expected a node entry"
it "exposes the index entry even on a fresh empty index" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
let allStatus = defaultShardStoresOptions {ssoStatus = Just (ShardStoresStatusAll :| [])}
stores <- performBHRequest $ getShardStoresWith testIndex allStatus
liftIO $ M.member testIndex (shardStoresIndices stores) `shouldBe` True
it "surfaces server-side errors (404) for a non-existent index" $ do
result <-
withTestEnv $
tryEsError (performBHRequest $ getShardStores [qqIndexName|bloodhound-no-such-index-04f-2-11|])
case result of
Left _ -> pure ()
Right _ -> expectationFailure "expected EsError for missing index, got success"
describe "GET /_resolve/index (resolveIndex)" $ do
-- Pure FromJSON unit tests exercise the @string | array[string]@
-- union and missing-field paths that the integration tests below
-- can't reach (the live server always emits the array form and
-- always populates every documented field).
describe "ResolvedIndices FromJSON" $ do
let decodeResolved = (decode :: BL8.ByteString -> Maybe ResolvedIndices)
it "parses aliases[].indices as an array of strings" $ do
let body =
BL8.pack
"{\"indices\":[],\"aliases\":[{\"name\":\"a1\",\"indices\":[\"ix1\",\"ix2\"]}],\"data_streams\":[]}"
let Just (resolved :: ResolvedIndices) = decodeResolved body
case resolvedIndicesAliases resolved of
[alias] -> resolvedAliasIndices alias `shouldBe` [[qqIndexName|ix1|], [qqIndexName|ix2|]]
other -> expectationFailure $ "expected one alias entry, got " <> show other
it "parses aliases[].indices as a bare string (ES-9.x OpenAPI union)" $ do
let body =
BL8.pack
"{\"indices\":[],\"aliases\":[{\"name\":\"a1\",\"indices\":\"ix1\"}],\"data_streams\":[]}"
let Just (resolved :: ResolvedIndices) = decodeResolved body
case resolvedIndicesAliases resolved of
[alias] -> resolvedAliasIndices alias `shouldBe` [[qqIndexName|ix1|]]
other -> expectationFailure $ "expected one alias entry, got " <> show other
it "parses a data_streams entry with bare-string backing_indices" $ do
let body =
BL8.pack
"{\"indices\":[],\"aliases\":[],\"data_streams\":[{\"name\":\"ds1\",\"backing_indices\":\"ds-ds1-2024-01-01-000001\",\"timestamp_field\":\"@timestamp\"}]}"
let Just (resolved :: ResolvedIndices) = decodeResolved body
case resolvedIndicesDataStreams resolved of
[ds] -> do
resolvedDataStreamName ds `shouldBe` "ds1"
resolvedDataStreamBackingIndices ds `shouldBe` [[qqIndexName|ds-ds1-2024-01-01-000001|]]
resolvedDataStreamTimestampField ds `shouldBe` "@timestamp"
other -> expectationFailure $ "expected one data stream entry, got " <> show other
it "treats a missing aliases field on an index entry as empty" $ do
let body =
BL8.pack
"{\"indices\":[{\"name\":\"ix1\",\"attributes\":[\"open\"]}],\"aliases\":[],\"data_streams\":[]}"
let Just (resolved :: ResolvedIndices) = decodeResolved body
case resolvedIndicesIndices resolved of
[entry] -> resolvedIndexAliases entry `shouldBe` []
other -> expectationFailure $ "expected one index entry, got " <> show other
it "treats a missing/null indices field on an alias entry as empty" $ do
let body =
BL8.pack
"{\"indices\":[],\"aliases\":[{\"name\":\"a1\"}],\"data_streams\":[]}"
let Just (resolved :: ResolvedIndices) = decodeResolved body
case resolvedIndicesAliases resolved of
[alias] -> resolvedAliasIndices alias `shouldBe` []
other -> expectationFailure $ "expected one alias entry, got " <> show other
let findResolvedIndex name = L.find (\e -> resolvedIndexName e == name) . resolvedIndicesIndices
findResolvedAlias name = L.find (\e -> resolvedAliasName e == name) . resolvedIndicesAliases
it "returns the requested index with its attributes" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
resolved <- performBHRequest $ resolveIndex [IndexPattern (unIndexName testIndex)]
case findResolvedIndex testIndex resolved of
Nothing ->
liftIO $
expectationFailure $
"expected an entry for " <> show testIndex <> ", got " <> show resolved
Just entry -> liftIO $ do
resolvedIndexName entry `shouldBe` testIndex
-- A freshly-created, open index reports "open" in its
-- attributes (the only universally-documented value across
-- ES and OpenSearch).
resolvedIndexAttributes entry `shouldContain` ["open"]
it "treats an empty pattern list as the wildcard *" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
resolved <- performBHRequest $ resolveIndex []
liftIO $
(testIndex `elem` map resolvedIndexName (resolvedIndicesIndices resolved))
`shouldBe` True
it "surfaces aliases both per-index and in the top-level aliases array" $
withTestEnv $ do
let aliasName = IndexAliasName [qqIndexName|bloodhound-tests-resolve-alias|]
alias = IndexAlias testIndex aliasName
aliasPattern = IndexPattern (unIndexName [qqIndexName|bloodhound-tests-resolve-alias|])
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ keepBHResponse $ updateIndexAliases (AddAlias alias defaultIndexAliasCreate :| [])
-- Resolving by *index* name lists the alias in the per-index
-- @aliases@ field.
byIndex <-
performBHRequest $
resolveIndex [IndexPattern (unIndexName testIndex)]
-- Resolving by *alias* name surfaces the alias in the
-- top-level @aliases@ array with its backing indices.
byAlias <- performBHRequest $ resolveIndex [aliasPattern]
-- Clean up the alias so the next test starts clean. (Best-effort;
-- a parse failure during the resolves above would leak it, but
-- the test itself would already be failing by then.)
_ <- performBHRequest $ deleteIndexAlias aliasName
case findResolvedIndex testIndex byIndex of
Nothing ->
liftIO $
expectationFailure $
"expected an entry for " <> show testIndex <> ", got " <> show byIndex
Just entry ->
liftIO $ (aliasName `elem` resolvedIndexAliases entry) `shouldBe` True
case findResolvedAlias aliasName byAlias of
Nothing ->
liftIO $
expectationFailure $
"expected a top-level alias entry for " <> show aliasName <> ", got " <> show byAlias
Just aliasEntry ->
liftIO $ (testIndex `elem` resolvedAliasIndices aliasEntry) `shouldBe` True
it "expands to closed indices when expand_wildcards includes closed" $
withTestEnv $ do
_ <- deleteExampleIndex
_ <- createExampleIndex
_ <- performBHRequest $ closeIndex testIndex
let opts =
defaultResolveIndexOptions
{ rioExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsClosed])
}
resolved <-
performBHRequest $
resolveIndexWith opts [IndexPattern (unIndexName testIndex)]
-- Reopen so downstream tests can use the index.
_ <- performBHRequest $ openIndex testIndex
case findResolvedIndex testIndex resolved of
Nothing ->
liftIO $
expectationFailure $
"expected a closed entry for " <> show testIndex <> ", got " <> show resolved
Just entry ->
liftIO $ (resolvedIndexAttributes entry `shouldContain` ["closed"])
it "returns an empty result for a missing concrete index" $
-- Note: how a missing concrete index is reported is version
-- dependent. ES 7 returns 200 with empty @indices@/@aliases@/
-- @data_streams@ arrays. ES 8/9 return a 404 unless
-- @ignore_unavailable=true@ is set, which restores the 200-empty
-- shape across every backend. We pass it here so the
-- 'StatusDependant' builder yields the empty 'ResolvedIndices'
-- uniformly; genuine server-side failures (auth, malformed
-- pattern, 5xx) still surface as 'EsError'.
withTestEnv $ do
resolved <-
performBHRequest $
resolveIndexWith
defaultResolveIndexOptions {rioIgnoreUnavailable = Just True}
[IndexPattern "bloodhound-no-such-index-04f-2-14"]
liftIO $
resolvedIndicesIndices resolved `shouldBe` []
-- ------------------------------------------------------------------ --
-- Index ops URI params (bloodhound-04f.7.17) --
-- open/close/flush/refresh --
-- (forcemerge intentionally omitted: no backend accepts --
-- master_timeout/timeout on _forcemerge — every tested server --
-- returns HTTP 400 "unrecognized parameters".) --
-- ------------------------------------------------------------------ --
describe "openCloseIndexOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultOpenCloseIndexOptions emits no params" $
openCloseIndexOptionsParams defaultOpenCloseIndexOptions
`shouldBe` []
it "renders wait_for_active_shards via ActiveShardCount" $ do
let opts = defaultOpenCloseIndexOptions {ocioWaitForActiveShards = Just AllActiveShards}
openCloseIndexOptionsParams opts
`shouldBe` [("wait_for_active_shards", Just "all")]
it "renders booleans as lowercase true/false" $ do
let opts =
defaultOpenCloseIndexOptions
{ ocioIgnoreUnavailable = Just True,
ocioAllowNoIndices = Just False
}
normalize (openCloseIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "false"),
("ignore_unavailable", Just "true")
]
it "renders expand_wildcards as a comma-separated list" $ do
let opts =
defaultOpenCloseIndexOptions
{ ocioExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsClosed])
}
openCloseIndexOptionsParams opts
`shouldBe` [("expand_wildcards", Just "open,closed")]
it "renders master_timeout and timeout as <n><suffix>" $ do
let opts =
defaultOpenCloseIndexOptions
{ ocioMasterTimeout = Just (TimeUnitSeconds, 30),
ocioTimeout = Just (TimeUnitMilliseconds, 500)
}
normalize (openCloseIndexOptionsParams opts)
`shouldBe` [ ("master_timeout", Just "30s"),
("timeout", Just "500ms")
]
it "emits every param together when all are set" $ do
let opts =
defaultOpenCloseIndexOptions
{ ocioWaitForActiveShards = Just (ActiveShards 2),
ocioIgnoreUnavailable = Just True,
ocioAllowNoIndices = Just True,
ocioExpandWildcards = Just (ExpandWildcardsOpen :| []),
ocioMasterTimeout = Just (TimeUnitMinutes, 1),
ocioTimeout = Just (TimeUnitSeconds, 10)
}
normalize (openCloseIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "true"),
("expand_wildcards", Just "open"),
("ignore_unavailable", Just "true"),
("master_timeout", Just "1m"),
("timeout", Just "10s"),
("wait_for_active_shards", Just "2")
]
describe "putMappingOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultPutMappingOptions emits no params" $
putMappingOptionsParams defaultPutMappingOptions
`shouldBe` []
it "renders booleans as lowercase true/false" $ do
let opts =
defaultPutMappingOptions
{ pmoIgnoreUnavailable = Just True,
pmoAllowNoIndices = Just False,
pmoWriteIndexOnly = Just True
}
normalize (putMappingOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "false"),
("ignore_unavailable", Just "true"),
("write_index_only", Just "true")
]
it "renders expand_wildcards as a comma-separated list" $ do
let opts =
defaultPutMappingOptions
{ pmoExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsClosed])
}
putMappingOptionsParams opts
`shouldBe` [("expand_wildcards", Just "open,closed")]
it "renders master_timeout and timeout as <n><suffix>" $ do
let opts =
defaultPutMappingOptions
{ pmoMasterTimeout = Just (TimeUnitSeconds, 30),
pmoTimeout = Just (TimeUnitMilliseconds, 500)
}
normalize (putMappingOptionsParams opts)
`shouldBe` [ ("master_timeout", Just "30s"),
("timeout", Just "500ms")
]
describe "putMapping endpoint shape" $ do
let idx = [qqIndexName|mapping-shape|]
it "PUTs /{index}/_mapping with no query string by default" $ do
let req = putMapping @Value idx (object [])
bhRequestMethod req `shouldBe` "PUT"
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["mapping-shape", "_mapping"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "putMappingWith forwards options onto the query string" $ do
let opts = defaultPutMappingOptions {pmoAllowNoIndices = Just True}
req = putMappingWith @Value idx (object []) opts
bhRequestMethod req `shouldBe` "PUT"
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("allow_no_indices", Just "true")]
describe "flushIndexOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultFlushIndexOptions emits no params" $
flushIndexOptionsParams defaultFlushIndexOptions
`shouldBe` []
it "renders booleans as lowercase true/false" $ do
let opts =
defaultFlushIndexOptions
{ fioWaitIfOngoing = Just True,
fioForce = Just False,
fioIgnoreUnavailable = Just True,
fioAllowNoIndices = Just False
}
normalize (flushIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "false"),
("force", Just "false"),
("ignore_unavailable", Just "true"),
("wait_if_ongoing", Just "true")
]
it "emits every param together when all are set" $ do
let opts =
defaultFlushIndexOptions
{ fioWaitIfOngoing = Just True,
fioForce = Just True,
fioIgnoreUnavailable = Just False,
fioAllowNoIndices = Just True,
fioExpandWildcards = Just (ExpandWildcardsAll :| [])
}
normalize (flushIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "true"),
("expand_wildcards", Just "all"),
("force", Just "true"),
("ignore_unavailable", Just "false"),
("wait_if_ongoing", Just "true")
]
describe "refreshIndexOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultRefreshIndexOptions emits no params" $
refreshIndexOptionsParams defaultRefreshIndexOptions
`shouldBe` []
it "renders booleans as lowercase true/false" $ do
let opts =
defaultRefreshIndexOptions
{ rfioIgnoreUnavailable = Just True,
rfioAllowNoIndices = Just False,
rfioForce = Just True
}
normalize (refreshIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "false"),
("force", Just "true"),
("ignore_unavailable", Just "true")
]
it "emits every param together when all are set" $ do
let opts =
defaultRefreshIndexOptions
{ rfioIgnoreUnavailable = Just False,
rfioAllowNoIndices = Just True,
rfioExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsHidden]),
rfioForce = Just True
}
normalize (refreshIndexOptionsParams opts)
`shouldBe` [ ("allow_no_indices", Just "true"),
("expand_wildcards", Just "open,hidden"),
("force", Just "true"),
("ignore_unavailable", Just "false")
]
describe "index ops *With integration" $ do
-- Live integration tests against the sandboxed test index. Each
-- exercises a parameterised *With variant end-to-end and checks for
-- a 2xx — proves the params are accepted (not rejected as unknown)
-- by the backend. The default-Options case is the regression for
-- the byte-identical legacy behaviour of the parameterless entry
-- points.
let withTestIndex action = withTestEnv $ do
_ <- createExampleIndex
r <- action
_ <- tryPerformBHRequest (deleteIndex testIndex)
pure r
it "openIndexWith/closeIndexWith round-trip with default options" $
withTestIndex $ do
closeResp <- performBHRequest $ closeIndexWith defaultOpenCloseIndexOptions testIndex
_ <- performBHRequest $ openIndexWith defaultOpenCloseIndexOptions testIndex
liftIO $ isAcknowledged closeResp `shouldBe` True
it "closeIndexWith accepts master_timeout and timeout" $
withTestIndex $ do
let opts =
defaultOpenCloseIndexOptions
{ ocioMasterTimeout = Just (TimeUnitSeconds, 30),
ocioTimeout = Just (TimeUnitSeconds, 10)
}
resp <- performBHRequest $ closeIndexWith opts testIndex
liftIO $ isAcknowledged resp `shouldBe` True
-- Reopen so cleanup can delete the index.
_ <- performBHRequest $ openIndex testIndex
pure ()
it "openIndexWith accepts wait_for_active_shards" $
withTestIndex $ do
_ <- performBHRequest $ closeIndex testIndex
let opts = defaultOpenCloseIndexOptions {ocioWaitForActiveShards = Just AllActiveShards}
resp <- performBHRequest $ openIndexWith opts testIndex
liftIO $ isAcknowledged resp `shouldBe` True
it "flushIndexWith accepts force and wait_if_ongoing" $
withTestIndex $ do
let opts =
defaultFlushIndexOptions
{ fioForce = Just True,
fioWaitIfOngoing = Just True
}
ShardsResult shardResult <- performBHRequest $ flushIndexWith opts testIndex
liftIO $ shardsSuccessful shardResult `shouldSatisfy` (>= 0)
it "refreshIndexWith accepts expand_wildcards" $
withTestIndex $ do
let opts =
defaultRefreshIndexOptions
{ rfioExpandWildcards = Just (ExpandWildcardsOpen :| [])
}
ShardsResult shardResult <- performBHRequest $ refreshIndexWith opts testIndex
liftIO $ shardsSuccessful shardResult `shouldSatisfy` (>= 0)
-- ----------------------------------------------------------------
-- Dangling indices API (bloodhound-04f.2.16)
-- GET /_dangling, POST /_dangling/{uuid}, DELETE /_dangling/{uuid}
-- Available since Elasticsearch 7.16 and OpenSearch 1.0. The
-- integration tests below run against every supported backend.
-- ----------------------------------------------------------------
describe "Dangling indices API (bloodhound-04f.2.16)" $ do
describe "DanglingIndicesResponse FromJSON" $ do
let decodeResp = (decode :: BL8.ByteString -> Maybe DanglingIndicesResponse)
it "parses a response with two entries" $ do
let body =
BL8.pack
"{\"dangling_indices\":[\
\{\"index_uuid\":\"abc-1\",\"index_name\":\"old-idx-1\",\"node_ids\":[\"node-a\"],\"creation_date_millis\":1436443200000},\
\{\"index_uuid\":\"abc-2\",\"index_name\":\"old-idx-2\",\"node_ids\":[\"node-b\"],\"creation_date_millis\":1436443200001}\
\]}"
let Just (resp :: DanglingIndicesResponse) = decodeResp body
length (danglingIndicesResponseList resp) `shouldBe` 2
let first = head (danglingIndicesResponseList resp)
second = danglingIndicesResponseList resp !! 1
danglingIndexUuid first `shouldBe` DanglingIndexUuid "abc-1"
danglingIndexIndexName first `shouldBe` "old-idx-1"
danglingIndexNodeIds first `shouldBe` ["node-a"]
danglingIndexCreationDateMillis first `shouldBe` 1436443200000
danglingIndexUuid second `shouldBe` DanglingIndexUuid "abc-2"
danglingIndexNodeIds second `shouldBe` ["node-b"]
danglingIndexCreationDateMillis second `shouldBe` 1436443200001
it "parses a node_ids array with multiple entries" $ do
let body =
BL8.pack
"{\"dangling_indices\":[{\"index_uuid\":\"abc\",\"index_name\":\"old\",\"node_ids\":[\"n1\",\"n2\",\"n3\"],\"creation_date_millis\":1436443200000}]}"
let Just (resp :: DanglingIndicesResponse) = decodeResp body
case danglingIndicesResponseList resp of
[entry] -> danglingIndexNodeIds entry `shouldBe` ["n1", "n2", "n3"]
other -> expectationFailure $ "expected one entry, got " <> show other
it "parses an empty dangling_indices array" $ do
let body = BL8.pack "{\"dangling_indices\":[]}"
let Just (resp :: DanglingIndicesResponse) = decodeResp body
danglingIndicesResponseList resp `shouldBe` []
it "rejects a response missing the required node_ids field" $ do
let body =
BL8.pack
"{\"dangling_indices\":[{\"index_uuid\":\"abc\",\"index_name\":\"old\",\"creation_date_millis\":1436443200000}]}"
decodeResp body `shouldBe` Nothing
it "rejects a response missing the required creation_date_millis field" $ do
let body =
BL8.pack
"{\"dangling_indices\":[{\"index_uuid\":\"abc\",\"index_name\":\"old\",\"node_ids\":[\"n\"]}]}"
decodeResp body `shouldBe` Nothing
it "treats a missing dangling_indices field as empty" $ do
let body = BL8.pack "{}"
let Just (resp :: DanglingIndicesResponse) = decodeResp body
danglingIndicesResponseList resp `shouldBe` []
describe "importDanglingIndexOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "default emits only accept_data_loss=true" $
normalize (importDanglingIndexOptionsParams defaultImportDanglingIndexOptions)
`shouldBe` [("accept_data_loss", Just "true")]
it "renders master_timeout and timeout as <n><suffix>" $ do
let opts =
defaultImportDanglingIndexOptions
{ idioMasterTimeout = Just (TimeUnitSeconds, 30),
idioTimeout = Just (TimeUnitMilliseconds, 500)
}
normalize (importDanglingIndexOptionsParams opts)
`shouldBe` [ ("accept_data_loss", Just "true"),
("master_timeout", Just "30s"),
("timeout", Just "500ms")
]
it "honours an explicit accept_data_loss = False" $ do
let opts = defaultImportDanglingIndexOptions {idioAcceptDataLoss = False}
normalize (importDanglingIndexOptionsParams opts)
`shouldBe` [("accept_data_loss", Just "false")]
describe "deleteDanglingIndexOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "default emits no params" $
deleteDanglingIndexOptionsParams defaultDeleteDanglingIndexOptions
`shouldBe` []
it "renders master_timeout and timeout as <n><suffix>" $ do
let opts =
defaultDeleteDanglingIndexOptions
{ ddioMasterTimeout = Just (TimeUnitSeconds, 30),
ddioTimeout = Just (TimeUnitSeconds, 10)
}
normalize (deleteDanglingIndexOptionsParams opts)
`shouldBe` [ ("master_timeout", Just "30s"),
("timeout", Just "10s")
]
-- Integration tests. The dangling-index endpoints exist on
-- ElasticSearch 7.16+ and OpenSearch 1.0+, so the live tests run
-- against every supported backend.
backendSpecific [ElasticSearch7, ElasticSearch8, ElasticSearch9, OpenSearch1, OpenSearch2, OpenSearch3] $ do
it "listDanglingIndices returns a list (typically empty on a clean cluster)" $
withTestEnv $ do
entries <- performBHRequest listDanglingIndices
-- A clean test cluster should not have dangling indices.
-- We only assert the call succeeded and returned a finite
-- list; we do NOT assert emptiness because a developer's
-- long-running cluster might genuinely have some.
liftIO $ length entries `shouldSatisfy` (>= 0)
it "deleteDanglingIndex on a non-existent UUID surfaces a 400 EsError" $
withTestEnv $ do
let missing = DanglingIndexUuid "nonexistent-uuid-bloodhound-04f-2-16"
outcome <- tryEsError (performBHRequest $ deleteDanglingIndex missing)
case outcome of
Left e ->
-- ES rejects unknown UUIDs with 400 (illegal_argument_exception:
-- "No dangling index found for UUID [...]") rather than 404.
liftIO $ errorStatus e `shouldBe` Just 400
Right _ ->
liftIO $
expectationFailure
"deleteDanglingIndex unexpectedly succeeded for a non-existent UUID"
-- Import-success path: skipped. Inducing a real dangling index
-- requires stopping the cluster, planting stale index files on
-- disk for a node, and restarting — a multi-step orchestration
-- that is out of scope for a single API bead. The 'importDanglingIndex'
-- builder is exercised end-to-end by the URI-rendering unit tests
-- above; the path and accept_data_loss query parameter are
-- verified there.
-- ------------------------------------------------------------------ --
-- indexBlockText: pure wire-string rendering (no ES required) --
-- ------------------------------------------------------------------ --
describe "indexBlockText rendering" $
it "covers every documented block wire string" $
map
indexBlockText
[IndexBlockWrite, IndexBlockRead, IndexBlockReadOnly, IndexBlockMetadata]
`shouldBe` ["write", "read", "read_only", "metadata"]
-- Pins the 'IndexBlock' -> 'UpdatableIndexSetting' correspondence used
-- by 'removeIndexBlock' to build the @PUT /_settings@ body. A swap of
-- two constructors here would silently clear the wrong block at
-- teardown, so lock in the mapping at the unit level (cf. the
-- bloodhound-5gs review: the integration test only exercises
-- 'IndexBlockWrite' end-to-end).
describe "indexBlockToSetting mapping" $
it "maps every IndexBlock to its matching BlocksX" $ do
indexBlockToSetting False IndexBlockWrite `shouldBe` BlocksWrite False
indexBlockToSetting False IndexBlockRead `shouldBe` BlocksRead False
indexBlockToSetting False IndexBlockReadOnly `shouldBe` BlocksReadOnly False
indexBlockToSetting False IndexBlockMetadata `shouldBe` BlocksMetaData False
indexBlockToSetting True IndexBlockWrite `shouldBe` BlocksWrite True
-- Pins the 'IndexBlock' -> 'UpdatableIndexSetting' mapping that
-- 'removeIndexBlock' (PUT /_settings) uses to clear a block. A wrong
-- mapping would otherwise fail silently in the 'withBlockedIndex'
-- teardown (which wraps 'removeIndexBlock' in 'tryPerformBHRequest')
-- and leak a blocked index rather than surface as a test failure —
-- cf. bloodhound-5gs.
describe "indexBlockToUpdatable mapping" $
it "maps every IndexBlock to its matching BlocksX False" $
map
indexBlockToUpdatable
[IndexBlockWrite, IndexBlockRead, IndexBlockReadOnly, IndexBlockMetadata]
`shouldBe` [ BlocksWrite False,
BlocksRead False,
BlocksReadOnly False,
BlocksMetaData False
]
-- ------------------------------------------------------------------ --
-- addIndexBlock integration (mirrors openIndexWith/closeIndexWith) --
-- ------------------------------------------------------------------ --
describe "addIndexBlock integration" $ do
-- 'addIndexBlock' is the dedicated-function shortcut for the
-- @'updateIndexSettings' ('BlocksWrite' 'True' :| [])@ workaround, so
-- each case verifies both the 'Acknowledged' response and that the
-- matching 'UpdatableIndexSetting' surfaces via 'getIndexSettings'.
--
-- Each test uses a unique index name (passed to 'withBlockedIndex') so
-- a stuck block on one index cannot cascade into the next test.
-- Without this, a left-on @read_only@ or @metadata@ block would make
-- the next test's 'createIndex' fail with HTTP 403 (not the expected
-- @resource_already_exists_exception@) — 'createExampleIndex' would
-- re-throw that, 'bracket_' wouldn't run teardown, and the stuck
-- index would leak into the cluster, breaking unrelated tests
-- (cluster-wide operations like @_cat\/indices@ fail while any
-- blocked index exists). Unique names break the chain.
--
-- Teardown uses 'removeIndexBlock', which routes through
-- @PUT /<index>/_settings@ with the matching @BlocksX False@
-- 'UpdatableIndexSetting' (the dedicated @/_block/<block>@
-- endpoint is add-only on every supported backend — see
-- bloodhound-5gs). The @PUT /_settings@ path is honoured by
-- ES\/OS even while a @metadata@ block rejects
-- @GET /<index>/_settings@.
let setupBlockedIndex idx =
-- 'tryPerformBHRequest': tolerate "resource_already_exists_exception"
-- from a leaked previous run; teardown will clean it up.
void $
tryPerformBHRequest $
createIndex
(IndexSettings (ShardCount 1) (ReplicaCount 0) defaultIndexMappingsLimits)
idx
teardownBlockedIndex idx block = do
void $ tryPerformBHRequest $ removeIndexBlock idx block
void $ tryPerformBHRequest (deleteIndex idx)
withBlockedIndex idx block action =
withTestEnv $ bracket_ (setupBlockedIndex idx) (teardownBlockedIndex idx block) action
-- Pairs of ('IndexBlock', matching 'UpdatableIndexSetting') for
-- the cases where 'getIndexSettings' can read the block back.
-- @metadata@ is excluded from the "surfaces" check: the metadata
-- block rejects @GET /<index>/_settings@ itself (verified
-- manually against a live ES9 cluster), so the only check is the
-- 'Acknowledged' response.
surfaceCases =
[ (IndexBlockWrite, BlocksWrite True),
(IndexBlockRead, BlocksRead True),
(IndexBlockReadOnly, BlocksReadOnly True)
]
forM_
surfaceCases
( \(block, expectedSetting) -> do
let label = "addIndexBlock " <> T.unpack (indexBlockText block)
idx = either (error . T.unpack) id $ mkIndexName ("bloodhound-tests-block-" <> indexBlockText block)
it (label <> " returns Acknowledged and surfaces in getIndexSettings") $
withBlockedIndex idx block $ do
resp <- performBHRequest $ addIndexBlock idx block
liftIO $ isAcknowledged resp `shouldBe` True
IndexSettingsSummary _ _ settings <-
performBHRequest $ getIndexSettings idx
liftIO $ settings `shouldContain` [expectedSetting]
)
-- @metadata@ blocks @GET /<index>/_settings@ itself, so only the
-- 'Acknowledged' response is checked.
it "addIndexBlock metadata returns Acknowledged" $ do
let idx = either (error . T.unpack) id $ mkIndexName "bloodhound-tests-block-metadata"
withBlockedIndex idx IndexBlockMetadata $ do
resp <- performBHRequest $ addIndexBlock idx IndexBlockMetadata
liftIO $ isAcknowledged resp `shouldBe` True
-- 'removeIndexBlock' is the load-bearing cleanup helper for every
-- test above. Test it directly so a regression that left it
-- unable to clear the block (cf. the original bloodhound-04f.2.15
-- implementation that used @DELETE /<index>/_block/<block>@,
-- which ES rejects with HTTP 405 — tracked in bloodhound-5gs —
-- or a hypothetical swap of its underlying verb; cf. the
-- clearKnnCache/warmupKnnIndex distinctness guard in
-- bloodhound-04f.6.2.6) would surface here rather than silently
-- letting teardown leak blocked indices.
it "removeIndexBlock clears an IndexBlockWrite applied by addIndexBlock" $ do
let idx = either (error . T.unpack) id $ mkIndexName "bloodhound-tests-block-remove"
withBlockedIndex idx IndexBlockWrite $ do
_ <- performBHRequest $ addIndexBlock idx IndexBlockWrite
IndexSettingsSummary _ _ before <-
performBHRequest $ getIndexSettings idx
liftIO $ before `shouldContain` [BlocksWrite True]
resp <- performBHRequest $ removeIndexBlock idx IndexBlockWrite
liftIO $ isAcknowledged resp `shouldBe` True
IndexSettingsSummary _ _ after <-
performBHRequest $ getIndexSettings idx
liftIO $ after `shouldNotContain` [BlocksWrite True]
-- Pins the 'StatusDependant' choice: a 404 for a missing index
-- surfaces as a structured 'EsError' (per 'parseEsResponse'),
-- matching the deleteIndexTemplate precedent in Test.TemplatesSpec.
it "addIndexBlock surfaces a missing index as EsError 404" $ do
let idx = either (error . T.unpack) id $ mkIndexName "bloodhound-no-such-index-block-04f-2-15"
result <-
withTestEnv $
tryPerformBHRequest (addIndexBlock idx IndexBlockWrite)
case result of
Left e -> errorStatus e `shouldBe` Just 404
Right _ -> expectationFailure "expected 404 EsError, got Acknowledged"
-- Mirrors the 'addIndexBlock' 404 test above. 'removeIndexBlock'
-- uses @PUT /<index>/_settings@ (not the add-only @/_block@ endpoint),
-- which also returns 404 for a missing index; the 'StatusDependant'
-- parser surfaces it as a structured 'EsError' rather than the
-- generic "Unable to parse body" that 'StatusIndependant' would
-- produce (cf. bloodhound-5gs review).
it "removeIndexBlock surfaces a missing index as EsError 404" $ do
let idx = either (error . T.unpack) id $ mkIndexName "bloodhound-no-such-index-block-5gs"
result <-
withTestEnv $
tryPerformBHRequest (removeIndexBlock idx IndexBlockWrite)
case result of
Left e -> errorStatus e `shouldBe` Just 404
Right _ -> expectationFailure "expected 404 EsError, got Acknowledged"
-- ----------------------------------------------------------------
-- Regression test for bloodhound-442:
-- BlocksX ToJSON must emit the index. prefix so that
-- updateIndexSettings can clear a read_only block while it is in
-- effect. Before the fix, the encoder produced {"blocks":{"read_only":false}}
-- (no index wrapper), which ES rejects with HTTP 400 once the
-- read_only block is applied — so the only way to clear the block was
-- the dedicated removeIndexBlock endpoint.
-- ----------------------------------------------------------------
describe "updateIndexSettings clears a read_only block (bloodhound-442 regression)" $ do
it "BlocksReadOnly False via updateIndexSettings lifts an existing read_only block" $ do
let idx = either (error . T.unpack) id $ mkIndexName "bloodhound-tests-blocks-442-regression"
withTestEnv
$ bracket_
( void $
tryPerformBHRequest $
createIndex
(IndexSettings (ShardCount 1) (ReplicaCount 0) defaultIndexMappingsLimits)
idx
)
( do
-- Clear the block first (in case the test body failed mid-flight)
void $ tryPerformBHRequest $ removeIndexBlock idx IndexBlockReadOnly
void $ tryPerformBHRequest $ deleteIndex idx
)
$ do
-- Apply the read_only block via the dedicated endpoint (works
-- regardless of encoder state).
_ <- performBHRequest $ addIndexBlock idx IndexBlockReadOnly
-- Now clear it via updateIndexSettings. Before the fix this
-- returned 400 ("blocked by: [FORBIDDEN/10/index read-only
-- (api)];" plus the unprefixed body would have been rejected
-- anyway). After the fix the body is {"index":{"blocks":{"read_only":false}}}
-- which ES accepts.
(resp, _) <-
performBHRequest $
keepBHResponse $
updateIndexSettings (BlocksReadOnly False :| []) idx
liftIO $ validateStatus resp 200
IndexSettingsSummary _ _ settings <-
performBHRequest $ getIndexSettings idx
liftIO $ settings `shouldNotContain` [BlocksReadOnly True]