bloodhound-1.0.0.0: tests/Test/ILMSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.ILMSpec (spec) where
import Control.Monad.IO.Class (liftIO)
import Data.Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types (parseMaybe)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List (sort)
import Data.Text qualified as Text
import Data.Time.Clock.POSIX (getPOSIXTime)
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.Common.Client qualified as CommonClient
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Common
import TestsUtils.Import
import Prelude
-- | Fixture mimicking the @GET /_ilm/policy@ response (two policies, keyed
-- by id). Adapted from the shape documented at
-- https://www.elastic.co/guide/en/elasticsearch/reference/current/ilm-get-lifecycle.html.
sampleListResponse :: LBS.ByteString
sampleListResponse =
"{\
\ \"my_policy\": {\
\ \"version\": 1,\
\ \"modified_date\": 1580000000000,\
\ \"modified_date_string\": \"2020-01-26T06:53:20.000Z\",\
\ \"policy\": {\
\ \"phases\": {\
\ \"warm\": {\
\ \"min_age\": \"10d\",\
\ \"actions\": { \"forcemerge\": { \"max_num_segments\": 1 } }\
\ }\
\ }\
\ },\
\ \"in_use_by\": {\
\ \"indices\": [\"logs-2020-01-26-000001\"],\
\ \"data_streams\": []\
\ }\
\ },\
\ \"other_policy\": {\
\ \"version\": 3,\
\ \"modified_date\": 1590000000000,\
\ \"modified_date_string\": \"2020-05-21T00:00:00.000Z\",\
\ \"policy\": { \"phases\": {} }\
\ }\
\}"
-- | Fixture mimicking the @GET /_ilm/policy/{id}@ response. ES still wraps the
-- single policy in a one-entry object keyed by id.
sampleSingleResponse :: LBS.ByteString
sampleSingleResponse =
"{\
\ \"my_policy\": {\
\ \"version\": 1,\
\ \"modified_date\": -1,\
\ \"modified_date_string\": \"2020-01-26T06:53:20.000Z\",\
\ \"policy\": {\
\ \"phases\": {\
\ \"hot\": {\
\ \"min_age\": \"0ms\",\
\ \"actions\": { \"rollover\": { \"max_size\": \"50gb\" } }\
\ }\
\ }\
\ }\
\ }\
\}"
policyIdKey :: ILMPolicyInfo -> Text
policyIdKey = unILMPolicyId . ilmPolicyInfoId
spec :: Spec
spec = describe "Index Lifecycle Management (ILM) API" $ do
describe "ILMInUseBy JSON" $ do
it "decodes both indices and data_streams" $ do
let decoded =
decode "{ \"indices\": [\"a\", \"b\"], \"data_streams\": [\"ds1\"] }" ::
Maybe ILMInUseBy
(map unIndexName . ilmInUseByIndices <$> decoded) `shouldBe` Just ["a", "b"]
(ilmInUseByDataStreams <$> decoded) `shouldBe` Just ["ds1"]
it "defaults missing arrays to []" $ do
let decoded = decode "{}" :: Maybe ILMInUseBy
(ilmInUseByIndices <$> decoded) `shouldBe` Just []
(ilmInUseByDataStreams <$> decoded) `shouldBe` Just []
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded =
decode "{ \"indices\": [\"x\"], \"data_streams\": [\"y\"] }" ::
Maybe ILMInUseBy
(decode . encode) decoded `shouldBe` Just decoded
describe "ILMPolicyInfo JSON (inner body)" $ do
-- The standalone decoder fills ilmPolicyInfoId with a placeholder ""
-- because the id is the JSON object key in the outer response, not a
-- field in the inner value. The outer ILMPolicies decoder overrides it.
it "decodes a single policy body (id stays as the placeholder)" $ do
let Just (Object o) = decode sampleSingleResponse
Just body = KM.lookup "my_policy" o
decoded = parseMaybe parseJSON body :: Maybe ILMPolicyInfo
ilmPolicyInfoId <$> decoded `shouldBe` Just (ILMPolicyId "")
ilmPolicyInfoVersion <$> decoded `shouldBe` Just (Just 1)
ilmPolicyInfoModifiedDate <$> decoded `shouldBe` Just (Just (-1))
ilmPolicyInfoModifiedDateString <$> decoded `shouldBe` Just (Just "2020-01-26T06:53:20.000Z")
-- policy body is opaque Value; just check it has the expected phases key
ilmPolicyInfoPolicy <$> decoded `shouldSatisfy` maybe False hasPhasesKey
ilmPolicyInfoInUseBy <$> decoded `shouldBe` Just Nothing
it "rejects a policy body missing the required 'policy' field" $ do
let decoded = decode "{ \"version\": 1 }" :: Maybe ILMPolicyInfo
decoded `shouldBe` Nothing
it "tolerates modern ES wire shape (modified_date as ISO-8601 string)" $ do
let decoded = decode sampleModernPolicyBodyBytes :: Maybe ILMPolicyInfo
ilmPolicyInfoVersion <$> decoded `shouldBe` Just (Just 2)
ilmPolicyInfoModifiedDate <$> decoded `shouldBe` Just Nothing
ilmPolicyInfoModifiedDateString
<$> decoded
`shouldBe` Just (Just "2026-06-20T07:49:06.354Z")
ilmPolicyInfoPolicy <$> decoded `shouldSatisfy` maybe False hasPhasesKey
it "prefers an explicit modified_date_string over the string-shaped modified_date" $ do
let decoded =
decode
"{ \"version\": 1\
\, \"modified_date\": \"2026-06-20T07:49:06.354Z\"\
\, \"modified_date_string\": \"2020-01-26T06:53:20.000Z\"\
\, \"policy\": { \"phases\": {} } }" ::
Maybe ILMPolicyInfo
ilmPolicyInfoModifiedDate <$> decoded `shouldBe` Just Nothing
ilmPolicyInfoModifiedDateString
<$> decoded
`shouldBe` Just (Just "2020-01-26T06:53:20.000Z")
describe "ILMPolicies JSON (keyed response)" $ do
it "decodes the list-all response, stamping each id from the JSON key" $ do
let Just policies = decode sampleListResponse :: Maybe ILMPolicies
ps = unILMPolicies policies
length ps `shouldBe` 2
sort (map policyIdKey ps) `shouldBe` ["my_policy", "other_policy"]
it "preserves the in_use_by field on the policy that has one" $ do
let Just policies = decode sampleListResponse :: Maybe ILMPolicies
myPolicy = head [p | p <- unILMPolicies policies, policyIdKey p == "my_policy"]
(map unIndexName . ilmInUseByIndices <$> ilmPolicyInfoInUseBy myPolicy)
`shouldBe` Just ["logs-2020-01-26-000001"]
it "decodes the single-policy response as a one-entry list" $ do
let Just policies = decode sampleSingleResponse :: Maybe ILMPolicies
ps = unILMPolicies policies
length ps `shouldBe` 1
policyIdKey (head ps) `shouldBe` "my_policy"
it "decodes an empty response {} as the empty list" $ do
let decoded = decode "{}" :: Maybe ILMPolicies
unILMPolicies <$> decoded `shouldBe` Just []
it "round-trips the full keyed response through ToJSON/FromJSON, preserving ids" $ do
let Just (policies :: ILMPolicies) = decode sampleListResponse
reEncoded = encode policies
case (decode reEncoded :: Maybe ILMPolicies) of
Just reDecoded ->
sort (map policyIdKey (unILMPolicies reDecoded))
`shouldBe` sort (map policyIdKey (unILMPolicies policies))
Nothing -> expectationFailure "round-trip decode returned Nothing"
it "rejects a top-level array (the response must be a keyed object)" $ do
let decoded = decode "[]" :: Maybe ILMPolicies
decoded `shouldBe` Nothing
it "rejects malformed JSON" $ do
let decoded = decode "{ this is not json" :: Maybe ILMPolicies
decoded `shouldBe` Nothing
describe "getILMPolicy endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
it "GETs /_ilm/policy when given Nothing" $ do
let req = Common.getILMPolicy Nothing
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "GETs /_ilm/policy/{id} when given Just pid" $ do
let req = Common.getILMPolicy (Just (ILMPolicyId "my_policy"))
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy", "my_policy"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "does not attach a body (GET semantics)" $ do
let req = Common.getILMPolicy Nothing
bhRequestBody req `shouldBe` Nothing
describe "ILMPolicy JSON (PUT body)" $ do
-- The request body wraps the user-supplied policy under "policy".
it "encodes the policy body under the 'policy' key" $ do
let body = object ["phases" .= object []]
encoded = encode (ILMPolicy body)
encoded `shouldBe` "{\"policy\":{\"phases\":{}}}"
it "round-trips through ToJSON/FromJSON" $ do
let body = object ["phases" .= object ["hot" .= object ["min_age" .= String "0ms"]]]
Just decoded = decode (encode (ILMPolicy body)) :: Maybe ILMPolicy
unILMPolicy decoded `shouldBe` body
it "decodes a wrapped body, extracting the policy field" $ do
let Just decoded =
decode "{ \"policy\": { \"phases\": {} } }" ::
Maybe ILMPolicy
unILMPolicy decoded `shouldBe` object ["phases" .= object []]
it "rejects a body missing the 'policy' field" $ do
let decoded = decode "{ \"version\": 1 }" :: Maybe ILMPolicy
decoded `shouldBe` Nothing
it "rejects a non-object body" $ do
let decoded = decode "[1,2,3]" :: Maybe ILMPolicy
decoded `shouldBe` Nothing
describe "putILMPolicy endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
it "PUTs /_ilm/policy/{id}" $ do
let req = Common.putILMPolicy (ILMPolicyId "my_policy") (ILMPolicy (object []))
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy", "my_policy"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "attaches the encoded policy as the request body" $ do
let policy = ILMPolicy (object ["phases" .= object []])
req = Common.putILMPolicy (ILMPolicyId "my_policy") policy
bhRequestBody req `shouldBe` Just (encode policy)
it "uses a distinct id in the path when given a different PolicyId" $ do
let req = Common.putILMPolicy (ILMPolicyId "other") (ILMPolicy (object []))
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy", "other"]
describe "deleteILMPolicy endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
it "DELETEs /_ilm/policy/{id}" $ do
let req = Common.deleteILMPolicy (ILMPolicyId "my_policy")
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy", "my_policy"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "uses the DELETE method" $ do
let req = Common.deleteILMPolicy (ILMPolicyId "my_policy")
bhRequestMethod req `shouldBe` "DELETE"
it "does not attach a body (DELETE semantics)" $ do
let req = Common.deleteILMPolicy (ILMPolicyId "my_policy")
bhRequestBody req `shouldBe` Nothing
it "uses a distinct id in the path when given a different PolicyId" $ do
let req = Common.deleteILMPolicy (ILMPolicyId "other")
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "policy", "other"]
-- --------------------------------------------------------------------------
-- GET /_ilm/explain/{index}
-- ---------------------------------------------------------------------------
describe "ILMExplanation JSON (per-index body)" $ do
-- Adapted from the example at
-- https://www.elastic.co/guide/en/elasticsearch/reference/current/ilm-explain-lifecycle.html
it "decodes the canonical managed-index example from the ES docs" $ do
let Just decoded = decode sampleExplainEntryBytes :: Maybe ILMExplanation
unIndexName (ilmExplanationIndex decoded) `shouldBe` "my-index-000001"
ilmExplanationManaged decoded `shouldBe` True
ilmExplanationPolicy decoded `shouldBe` Just "my_policy"
ilmExplanationPhase decoded `shouldBe` Just "new"
ilmExplanationAction decoded `shouldBe` Just "complete"
ilmExplanationStep decoded `shouldBe` Just "complete"
ilmExplanationPhaseTimeMillis decoded `shouldBe` Just 1538475653317
ilmExplanationActionTimeMillis decoded `shouldBe` Just 1538475653317
ilmExplanationStepTimeMillis decoded `shouldBe` Just 1538475653317
ilmExplanationLifecycleDateMillis decoded `shouldBe` Just 1538475653281
ilmExplanationIndexCreationDateMillis decoded `shouldBe` Just 1538475653281
ilmExplanationAge decoded `shouldBe` Just "15s"
ilmExplanationTimeSinceIndexCreation decoded `shouldBe` Just "15s"
ilmExplanationStepInfo decoded `shouldBe` Nothing
it "decodes an unmanaged index, leaving every optional field as Nothing" $ do
let Just decoded = decode "{ \"index\": \"foo\", \"managed\": false }" :: Maybe ILMExplanation
unIndexName (ilmExplanationIndex decoded) `shouldBe` "foo"
ilmExplanationManaged decoded `shouldBe` False
ilmExplanationPolicy decoded `shouldBe` Nothing
ilmExplanationPhase decoded `shouldBe` Nothing
ilmExplanationStepInfo decoded `shouldBe` Nothing
it "decodes an error-state entry, carrying step_info as an opaque Value" $ do
let Just decoded =
decode
"{ \"index\": \"broken-idx\"\
\, \"managed\": true\
\, \"policy\": \"p\"\
\, \"phase\": \"hot\"\
\, \"action\": \"rollover\"\
\, \"step\": \"ERROR\"\
\, \"step_info\": { \"type\": \"illegal_argument_exception\"\
\ , \"reason\": \"setting [index.lifecycle.indexing_complete]\" } }" ::
Maybe ILMExplanation
ilmExplanationStep decoded `shouldBe` Just "ERROR"
case ilmExplanationStepInfo decoded of
Just (Object o) -> "reason" `KM.member` o `shouldBe` True
_ -> expectationFailure "expected step_info to decode as a JSON object"
it "treats an explicit \"step_info\": null the same as a missing field" $ do
-- Aeson's .:? returns Nothing for both, pinning the behaviour so a
-- future stricter parser cannot silently regress it.
let Just decoded = decode "{ \"index\": \"ix\", \"managed\": true, \"step_info\": null }" :: Maybe ILMExplanation
ilmExplanationStepInfo decoded `shouldBe` Nothing
it "tolerates unknown extra fields in the body" $ do
-- The wire shape will grow new fields over time; decode must not
-- reject bodies just because ES added a key we don't model yet.
let Just decoded =
decode
"{ \"index\": \"ix\", \"managed\": true\
\, \"future_field\": \"whatever\", \"another\": 42 }" ::
Maybe ILMExplanation
ilmExplanationManaged decoded `shouldBe` True
it "round-trips through ToJSON/FromJSON" $ do
let Just (decoded :: ILMExplanation) = decode sampleExplainEntryBytes
(decode . encode) decoded `shouldBe` Just decoded
it "rejects a body missing the required 'managed' field" $ do
let decoded = decode "{ \"index\": \"foo\" }" :: Maybe ILMExplanation
decoded `shouldBe` Nothing
it "rejects a body missing the required 'index' field" $ do
let decoded = decode "{ \"managed\": true }" :: Maybe ILMExplanation
decoded `shouldBe` Nothing
describe "ILMExplanations JSON (keyed response)" $ do
it "decodes the full response, returning one entry per matched index" $ do
let Just decoded = decode sampleExplainResponseBytes :: Maybe ILMExplanations
entries = unILMExplanations decoded
length entries `shouldBe` 2
sort (map (unIndexName . ilmExplanationIndex) entries)
`shouldBe` ["logs-2024-01-01-000001", "my-index-000001"]
it "preserves the managed flag and policy from each entry" $ do
let Just decoded = decode sampleExplainResponseBytes :: Maybe ILMExplanations
managed = head [e | e <- unILMExplanations decoded, unIndexName (ilmExplanationIndex e) == "my-index-000001"]
ilmExplanationManaged managed `shouldBe` True
ilmExplanationPolicy managed `shouldBe` Just "my_policy"
it "decodes an empty indices object as the empty list" $ do
let Just decoded = decode "{ \"indices\": {} }" :: Maybe ILMExplanations
unILMExplanations decoded `shouldBe` []
it "round-trips the full keyed response through ToJSON/FromJSON" $ do
-- Assert the *full* bodies (not just index names) survive encode/decode.
let Just (decoded :: ILMExplanations) = decode sampleExplainResponseBytes
case (decode . encode) decoded :: Maybe ILMExplanations of
Just reDecoded -> reDecoded `shouldBe` decoded
Nothing -> expectationFailure "round-trip decode returned Nothing"
it "rejects a top-level array" $ do
decode "[]" `shouldBe` (Nothing :: Maybe ILMExplanations)
it "rejects a response missing the 'indices' wrapper" $ do
decode "{ \"my-index-000001\": { \"index\": \"x\", \"managed\": true } }"
`shouldBe` (Nothing :: Maybe ILMExplanations)
describe "explainILM endpoint shape" $ do
it "GETs /_ilm/explain/{index} with no body and no queries" $ do
let req = Common.explainILM [qqIndexName|my-index|]
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "explain", "my-index"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Nothing
-- Note: IndexName validation rejects wildcard characters (e.g. "logs-*")
-- so the wildcard form of the index path segment is out of reach until
-- Bloodhound relaxes IndexName. Out of scope for this bead.
describe "explainILMWith options rendering" $ do
it "emits no queries for defaultILMExplainOptions (≡ explainILM)" $ do
let simple = Common.explainILM [qqIndexName|ix|]
withDefaults = Common.explainILMWith defaultILMExplainOptions [qqIndexName|ix|]
bhRequestEndpoint simple `shouldBe` bhRequestEndpoint withDefaults
it "renders only_errors, only_managed and master_timeout when set" $ do
let opts =
defaultILMExplainOptions
{ ilmeoOnlyErrors = Just True,
ilmeoOnlyManaged = Just False,
ilmeoMasterTimeout = Just (TimeUnitSeconds, 30)
}
req = Common.explainILMWith opts [qqIndexName|ix|]
queries = getRawEndpointQueries (bhRequestEndpoint req)
lookup "only_errors" queries `shouldBe` Just (Just "true")
lookup "only_managed" queries `shouldBe` Just (Just "false")
lookup "master_timeout" queries `shouldBe` Just (Just "30s")
it "renders master_timeout across the full TimeUnits grammar" $ do
-- Table-driven to pin each constructor's wire suffix; future
-- additions to TimeUnits will need a matching case here.
let render u n =
lookup "master_timeout" $
getRawEndpointQueries $
bhRequestEndpoint $
Common.explainILMWith
defaultILMExplainOptions {ilmeoMasterTimeout = Just (u, n)}
[qqIndexName|ix|]
render TimeUnitDays 7 `shouldBe` Just (Just "7d")
render TimeUnitHours 2 `shouldBe` Just (Just "2h")
render TimeUnitMinutes 5 `shouldBe` Just (Just "5m")
render TimeUnitMilliseconds 500 `shouldBe` Just (Just "500ms")
render TimeUnitMicroseconds 1000 `shouldBe` Just (Just "1000micros")
render TimeUnitNanoseconds 1 `shouldBe` Just (Just "1nanos")
it "ilmExplainOptionsParams yields [] for the default record" $ do
Common.ilmExplainOptionsParams defaultILMExplainOptions `shouldBe` []
-- ----------------------------------------------------------------------
-- ILM control: start / stop / status / move / retry / remove
-- ----------------------------------------------------------------------
describe "ILMStepKey JSON" $ do
-- The wire-shape gotcha: the step identifier lives under the "name"
-- key (NOT "step"), unlike ilmExplanationStep in the explain response.
-- The next two tests pin that.
it "encodes the step identifier under the \"name\" key, not \"step\"" $ do
let key =
ILMStepKey
{ ilmStepKeyPhase = "hot",
ilmStepKeyAction = Just "rollover",
ilmStepKeyName = Just "check-rollover-ready"
}
Object o = toJSON key
KM.member "name" o `shouldBe` True
KM.member "step" o `shouldBe` False
KM.lookup "phase" o `shouldBe` Just (String "hot")
KM.lookup "name" o `shouldBe` Just (String "check-rollover-ready")
it "round-trips a fully-populated key through ToJSON/FromJSON" $ do
let key =
ILMStepKey
{ ilmStepKeyPhase = "warm",
ilmStepKeyAction = Just "forcemerge",
ilmStepKeyName = Just "forcemerge"
}
(decode . encode) key `shouldBe` Just key
it "omits the optional action and name when they are Nothing" $ do
let key = ILMStepKey {ilmStepKeyPhase = "hot", ilmStepKeyAction = Nothing, ilmStepKeyName = Nothing}
Object o = toJSON key
KM.toList o `shouldBe` [("phase", String "hot")]
it "decodes a phase-only key, leaving action and name as Nothing" $ do
let Just decoded = decode "{ \"phase\": \"delete\" }" :: Maybe ILMStepKey
ilmStepKeyPhase decoded `shouldBe` "delete"
ilmStepKeyAction decoded `shouldBe` Nothing
ilmStepKeyName decoded `shouldBe` Nothing
it "rejects a body missing the required phase field" $ do
let decoded = decode "{ \"action\": \"rollover\", \"name\": \"x\" }" :: Maybe ILMStepKey
decoded `shouldBe` Nothing
describe "MoveStepRequest JSON" $ do
let cur = ILMStepKey "new" (Just "complete") (Just "complete")
nxt = ILMStepKey "warm" (Just "forcemerge") (Just "forcemerge")
req = MoveStepRequest cur nxt
it "emits current_step and next_step wrappers" $ do
let Object o = toJSON req
KM.member "current_step" o `shouldBe` True
KM.member "next_step" o `shouldBe` True
it "round-trips through ToJSON/FromJSON" $ do
(decode . encode) req `shouldBe` Just req
it "rejects a body missing next_step" $ do
let decoded =
decode
"{ \"current_step\": { \"phase\": \"new\" } }" ::
Maybe MoveStepRequest
decoded `shouldBe` Nothing
it "rejects a body missing current_step" $ do
let decoded =
decode
"{ \"next_step\": { \"phase\": \"new\" } }" ::
Maybe MoveStepRequest
decoded `shouldBe` Nothing
describe "ILMOperationMode JSON" $ do
-- Table-driven round-trip across the full Bounded/Enum surface.
let roundTrips mode wire =
(encode mode, decode wire :: Maybe ILMOperationMode)
`shouldBe` (wire, Just mode)
it "round-trips RUNNING with the all-caps wire spelling" $
roundTrips ILMOperationModeRunning "\"RUNNING\""
it "round-trips STOPPING with the all-caps wire spelling" $
roundTrips ILMOperationModeStopping "\"STOPPING\""
it "round-trips STOPPED with the all-caps wire spelling" $
roundTrips ILMOperationModeStopped "\"STOPPED\""
it "rejects an unknown mode string" $ do
let decoded = decode "\"PAUSED\"" :: Maybe ILMOperationMode
decoded `shouldBe` Nothing
it "rejects a lower-case spelling (the wire form is upper case)" $ do
let decoded = decode "\"running\"" :: Maybe ILMOperationMode
decoded `shouldBe` Nothing
describe "ILMStatus JSON" $ do
it "decodes the canonical RUNNING response" $ do
let Just decoded = decode "{ \"operation_mode\": \"RUNNING\" }" :: Maybe ILMStatus
ilmStatusOperationMode decoded `shouldBe` ILMOperationModeRunning
it "round-trips through ToJSON/FromJSON" $ do
let status = ILMStatus ILMOperationModeStopped
(decode . encode) status `shouldBe` Just status
it "rejects a body missing operation_mode" $ do
let decoded = decode "{ \"other\": true }" :: Maybe ILMStatus
decoded `shouldBe` Nothing
describe "startILM/stopILM endpoint shape" $ do
it "POSTs /_ilm/start with an empty body and no queries" $ do
let req = Common.startILM
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "start"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Just ""
it "POSTs /_ilm/stop with an empty body and no queries" $ do
let req = Common.stopILM
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "stop"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Just ""
describe "getILMStatus endpoint shape" $ do
it "GETs /_ilm/status with no body and no queries" $ do
let req = Common.getILMStatus
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "status"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Nothing
describe "moveILMStep endpoint shape" $ do
let body =
MoveStepRequest
(ILMStepKey "new" (Just "complete") (Just "complete"))
(ILMStepKey "warm" (Just "forcemerge") (Just "forcemerge"))
it "POSTs /_ilm/move/{index} carrying the encoded MoveStepRequest body" $ do
let req = Common.moveILMStep [qqIndexName|my-index|] body
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "move", "my-index"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Just (encode body)
it "forwards a different index name into the path" $ do
let req = Common.moveILMStep [qqIndexName|logs-000001|] body
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "move", "logs-000001"]
describe "retryILMStep/removeILM endpoint shape" $ do
it "POSTs /_ilm/retry/{index} with an empty body and no queries" $ do
let req = Common.retryILMStep [qqIndexName|my-index|]
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "retry", "my-index"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Just ""
it "POSTs /_ilm/remove/{index} with an empty body and no queries" $ do
let req = Common.removeILM [qqIndexName|my-index|]
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "remove", "my-index"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Just ""
describe "MigrateDataTiersRequest JSON" $ do
it "encodes both fields when present" $ do
let req =
MigrateDataTiersRequest
{ migrateDataTiersRequestLegacyTemplateToDelete = Just "old-template",
migrateDataTiersRequestNodeAttribute = Just "data_hot"
}
encode req `shouldBe` "{\"legacy_template_to_delete\":\"old-template\",\"node_attribute\":\"data_hot\"}"
it "omits absent fields (defaultMigrateDataTiersRequest renders as empty object)" $ do
encode defaultMigrateDataTiersRequest `shouldBe` "{}"
it "decodes both fields" $ do
let Just decoded = decode "{\"legacy_template_to_delete\":\"t\",\"node_attribute\":\"a\"}" :: Maybe MigrateDataTiersRequest
migrateDataTiersRequestLegacyTemplateToDelete decoded `shouldBe` Just "t"
migrateDataTiersRequestNodeAttribute decoded `shouldBe` Just "a"
it "decodes an empty body as the empty request" $ do
let Just decoded = decode "{}" :: Maybe MigrateDataTiersRequest
decoded `shouldBe` defaultMigrateDataTiersRequest
describe "MigrateDataTiersResponse JSON" $ do
let fullBytes =
"{\
\ \"dry_run\": true,\
\ \"removed_legacy_template\": \"legacy-logs-template\",\
\ \"migrated_ilm_policies\": [\"logs\", \"metrics\"],\
\ \"migrated_indices\": [\"logs-2024\", \"logs-2023\"],\
\ \"migrated_legacy_templates\": [\"old-tpl\"],\
\ \"migrated_composable_templates\": [\"logs-template\"],\
\ \"migrated_component_templates\": [\"logs-component\"]\
\}"
it "decodes a full dry-run response" $ do
let Just decoded = decode fullBytes :: Maybe MigrateDataTiersResponse
migrateDataTiersResponseDryRun decoded `shouldBe` True
migrateDataTiersResponseRemovedLegacyTemplate decoded `shouldBe` Just "legacy-logs-template"
migrateDataTiersResponseMigratedIlmPolicies decoded `shouldBe` ["logs", "metrics"]
migrateDataTiersResponseMigratedIndices decoded `shouldBe` ["logs-2024", "logs-2023"]
migrateDataTiersResponseMigratedLegacyTemplates decoded `shouldBe` ["old-tpl"]
migrateDataTiersResponseMigratedComposableTemplates decoded `shouldBe` ["logs-template"]
migrateDataTiersResponseMigratedComponentTemplates decoded `shouldBe` ["logs-component"]
it "decodes migrated_indices when it is a bare string (union wire shape)" $ do
let bytes =
"{\
\ \"dry_run\": false,\
\ \"migrated_ilm_policies\": [],\
\ \"migrated_indices\": \"only-index\",\
\ \"migrated_legacy_templates\": [],\
\ \"migrated_composable_templates\": [],\
\ \"migrated_component_templates\": []\
\}"
Just decoded = decode bytes :: Maybe MigrateDataTiersResponse
migrateDataTiersResponseMigratedIndices decoded `shouldBe` ["only-index"]
migrateDataTiersResponseDryRun decoded `shouldBe` False
it "tolerates a missing removed_legacy_template (documented as required but often absent)" $ do
let bytes =
"{\
\ \"dry_run\": false,\
\ \"migrated_ilm_policies\": [],\
\ \"migrated_indices\": [],\
\ \"migrated_legacy_templates\": [],\
\ \"migrated_composable_templates\": [],\
\ \"migrated_component_templates\": []\
\}"
Just decoded = decode bytes :: Maybe MigrateDataTiersResponse
migrateDataTiersResponseRemovedLegacyTemplate decoded `shouldBe` Nothing
it "round-trips through ToJSON/FromJSON (re-emitting migrated_indices as an array)" $ do
let Just decoded = decode fullBytes :: Maybe MigrateDataTiersResponse
Just reDecoded = decode (encode decoded) :: Maybe MigrateDataTiersResponse
reDecoded `shouldBe` decoded
describe "migrateDataTiers endpoint shape" $ do
let req = Common.migrateDataTiers
it "POSTs /_ilm/migrate_to_data_tiers" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "migrate_to_data_tiers"]
it "uses the POST method" $ do
bhRequestMethod req `shouldBe` "POST"
it "sends an empty body (defaultMigrateDataTiersRequest encodes to {})" $ do
bhRequestBody req `shouldBe` Just "{}"
it "carries no query string by default" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "migrateDataTiersWith endpoint shape" $ do
it "emits dry_run=true when the option is set" $ do
let opts = defaultMigrateDataTiersOptions {migrateDataTiersOptionsDryRun = Just True}
req = Common.migrateDataTiersWith opts defaultMigrateDataTiersRequest
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_ilm", "migrate_to_data_tiers"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` [("dry_run", Just "true")]
it "emits dry_run=false when the option is unset explicitly" $ do
let opts = defaultMigrateDataTiersOptions {migrateDataTiersOptionsDryRun = Just False}
req = Common.migrateDataTiersWith opts defaultMigrateDataTiersRequest
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` [("dry_run", Just "false")]
it "omits dry_run entirely when the option is Nothing" $ do
let req = Common.migrateDataTiersWith defaultMigrateDataTiersOptions defaultMigrateDataTiersRequest
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "encodes the request body fields" $ do
let body =
defaultMigrateDataTiersRequest
{ migrateDataTiersRequestNodeAttribute = Just "data_hot"
}
req = Common.migrateDataTiersWith defaultMigrateDataTiersOptions body
bhRequestBody req `shouldBe` Just "{\"node_attribute\":\"data_hot\"}"
backendSpecific
[ElasticSearch7, ElasticSearch8, ElasticSearch9]
$ describe "getILMPolicy (live integration)"
$ do
it "round-trips a single policy via Just pid" $
withTestEnv $ do
suffix <- liftIO $ show @Int . floor <$> getPOSIXTime
let pid =
ILMPolicyId $
Text.pack $
"bloodhound_test_ilm_live_pid_" <> suffix
_ <- CommonClient.putILMPolicy pid sampleLivePolicy
policies <- CommonClient.getILMPolicy (Just pid)
liftIO $
case policies of
[p] -> do
ilmPolicyInfoId p `shouldBe` pid
ilmPolicyInfoPolicy p `shouldSatisfy` hasPhasesKey
_ ->
expectationFailure $
"expected exactly one policy, got " <> show (length policies)
it "lists the created policy via Nothing" $
withTestEnv $ do
suffix <- liftIO $ show @Int . floor <$> getPOSIXTime
let pid =
ILMPolicyId $
Text.pack $
"bloodhound_test_ilm_live_list_" <> suffix
_ <- CommonClient.putILMPolicy pid sampleLivePolicy
policies <- CommonClient.getILMPolicy Nothing
liftIO $
map (unILMPolicyId . ilmPolicyInfoId) policies
`shouldSatisfy` elem (unILMPolicyId pid)
backendSpecific
[ElasticSearch7, ElasticSearch8, ElasticSearch9]
$ describe "deleteILMPolicy (live integration)"
$ do
it "removes a policy that was just created" $
withTestEnv $ do
suffix <- liftIO $ show @Int . floor <$> getPOSIXTime
let pid =
ILMPolicyId $
Text.pack $
"bloodhound_test_ilm_live_del_" <> suffix
_ <- CommonClient.putILMPolicy pid sampleLivePolicy
_ <- CommonClient.deleteILMPolicy pid
policies <- CommonClient.getILMPolicy Nothing
liftIO $
map (unILMPolicyId . ilmPolicyInfoId) policies
`shouldSatisfy` notElem (unILMPolicyId pid)
-- | Single per-index entry, copied from the canonical example at
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/ilm-explain-lifecycle.html>.
sampleExplainEntryBytes :: LBS.ByteString
sampleExplainEntryBytes =
"{\
\ \"index\": \"my-index-000001\",\n\
\ \"index_creation_date_millis\": 1538475653281,\n\
\ \"index_creation_date\": \"2018-10-15T13:45:21.981Z\",\n\
\ \"time_since_index_creation\": \"15s\",\n\
\ \"managed\": true,\n\
\ \"policy\": \"my_policy\",\n\
\ \"lifecycle_date_millis\": 1538475653281,\n\
\ \"lifecycle_date\": \"2018-10-15T13:45:21.981Z\",\n\
\ \"age\": \"15s\",\n\
\ \"phase\": \"new\",\n\
\ \"phase_time_millis\": 1538475653317,\n\
\ \"phase_time\": \"2018-10-15T13:45:22.577Z\",\n\
\ \"action\": \"complete\",\n\
\ \"action_time_millis\": 1538475653317,\n\
\ \"action_time\": \"2018-10-15T13:45:22.577Z\",\n\
\ \"step\": \"complete\",\n\
\ \"step_time_millis\": 1538475653317,\n\
\ \"step_time\": \"2018-10-15T13:45:22.577Z\"\n\
\}"
-- | Two-index response used to assert the keyed-response walking and
-- multi-entry decode. The second index is unmanaged, exercising the
-- 'Maybe' field decoding.
sampleExplainResponseBytes :: LBS.ByteString
sampleExplainResponseBytes =
"{\
\ \"indices\": {\n\
\ \"my-index-000001\": "
<> sampleExplainEntryBytes
<> ",\n\
\ \"logs-2024-01-01-000001\": {\n\
\ \"index\": \"logs-2024-01-01-000001\",\n\
\ \"managed\": false\n\
\ }\n\
\ }\n\
\}"
-- | Modern ES (7.17+\/8\/9) wire shape for a single policy body:
-- @modified_date@ is an ISO-8601 string and there is no
-- @modified_date_string@ sibling. Pins the tolerant parser independently of
-- the live cluster (the classic-shape fixtures above use epoch-millis).
sampleModernPolicyBodyBytes :: LBS.ByteString
sampleModernPolicyBodyBytes =
"{\
\ \"version\": 2,\n\
\ \"modified_date\": \"2026-06-20T07:49:06.354Z\",\n\
\ \"policy\": { \"phases\": {} }\n\
\}"
-- | Minimal ILM policy body used by the live integration tests: a single
-- @warm@ phase with a @forcemerge@ action. Small enough to be accepted by
-- every supported ES version (7.17+) and recognisable enough that the
-- round-trip assertion can confirm the body survived the PUT\/GET cycle.
sampleLivePolicy :: ILMPolicy
sampleLivePolicy =
ILMPolicy $
object
[ "phases"
.= object
[ "warm"
.= object
[ "min_age" .= ("10d" :: Text),
"actions"
.= object
[ "forcemerge"
.= object ["max_num_segments" .= (1 :: Int)]
]
]
]
]
-- | True iff the given Value is an object containing a @phases@ key. Used to
-- assert the opaque policy body without modelling the full ILM schema.
hasPhasesKey :: Value -> Bool
hasPhasesKey (Object o) = "phases" `KM.member` o
hasPhasesKey _ = False