bloodhound-1.0.0.0: tests/Test/ClusterSettingsSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.ClusterSettingsSpec where
import Control.Monad.Catch (bracket_)
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as AKM
import Data.HashMap.Strict qualified as HM
import Data.List qualified as L
import Data.Text qualified as T
import Database.Bloodhound.Common.Client qualified as Client
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Common
import TestsUtils.Import
spec :: Spec
spec = do
describe "cluster settings API" $ do
it "getClusterSettings decodes persistent and transient maps" $
withTestEnv $ do
settings <- Client.getClusterSettings
-- Persistent and transient are always present in the response
-- (they may be empty on a fresh cluster, but the keys exist).
-- Defaults absent because include_defaults was not sent.
liftIO $ clusterSettingsDefaults settings `shouldBe` Nothing
it "getClusterSettingsWith defaultClusterSettingsOptions matches the bare call" $
withTestEnv $ do
bare <- Client.getClusterSettings
withOpts <- Client.getClusterSettingsWith defaultClusterSettingsOptions
liftIO $ clusterSettingsPersistent bare `shouldBe` clusterSettingsPersistent withOpts
liftIO $ clusterSettingsTransient bare `shouldBe` clusterSettingsTransient withOpts
-- Defaults are not requested in either call.
liftIO $ clusterSettingsDefaults bare `shouldBe` Nothing
liftIO $ clusterSettingsDefaults withOpts `shouldBe` Nothing
it "getClusterSettingsWith include_defaults=True populates the defaults layer" $
withTestEnv $ do
let opts = defaultClusterSettingsOptions {csoIncludeDefaults = Just True}
settings <- Client.getClusterSettingsWith opts
-- ES always ships a large built-in defaults map.
liftIO $ clusterSettingsDefaults settings `shouldSatisfy` isJust
liftIO $
clusterSettingsDefaults settings
`shouldSatisfy` maybe False (not . null)
it "getClusterSettingsWith flat_settings=True still decodes" $
withTestEnv $ do
let opts = defaultClusterSettingsOptions {csoFlatSettings = Just True}
settings <- Client.getClusterSettingsWith opts
-- With flat_settings the keys are dotted strings, but the
-- outer shape (persistent + transient) is unchanged.
liftIO $ clusterSettingsDefaults settings `shouldBe` Nothing
it "getClusterSettingsWith include_defaults+flat_settings=True populates flat defaults" $
withTestEnv $ do
let opts =
defaultClusterSettingsOptions
{ csoIncludeDefaults = Just True,
csoFlatSettings = Just True
}
settings <- Client.getClusterSettingsWith opts
liftIO $
clusterSettingsDefaults settings
`shouldSatisfy` maybe False (not . null)
-- ------------------------------------------------------------------ --
-- clusterSettingsOptionsParams: pure URI rendering (no ES required) --
-- ------------------------------------------------------------------ --
describe "clusterSettingsOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultClusterSettingsOptions emits no params" $
clusterSettingsOptionsParams defaultClusterSettingsOptions
`shouldBe` []
it "renders flat_settings as lowercase true/false" $ do
let opts = defaultClusterSettingsOptions {csoFlatSettings = Just True}
clusterSettingsOptionsParams opts `shouldBe` [("flat_settings", Just "true")]
let opts' = defaultClusterSettingsOptions {csoFlatSettings = Just False}
clusterSettingsOptionsParams opts' `shouldBe` [("flat_settings", Just "false")]
it "renders include_defaults as lowercase true/false" $ do
let opts = defaultClusterSettingsOptions {csoIncludeDefaults = Just True}
clusterSettingsOptionsParams opts `shouldBe` [("include_defaults", Just "true")]
it "renders master_timeout as <n><suffix>" $ do
let opts = defaultClusterSettingsOptions {csoMasterTimeout = Just (TimeUnitSeconds, 30)}
clusterSettingsOptionsParams opts `shouldBe` [("master_timeout", Just "30s")]
it "emits every param together when all are set" $ do
let opts =
defaultClusterSettingsOptions
{ csoFlatSettings = Just True,
csoMasterTimeout = Just (TimeUnitMilliseconds, 500),
csoIncludeDefaults = Just False
}
normalize (clusterSettingsOptionsParams opts)
`shouldBe` [ ("flat_settings", Just "true"),
("include_defaults", Just "false"),
("master_timeout", Just "500ms")
]
-- ------------------------------------------------------------------ --
-- ClusterSettings JSON roundtrip: pure, no ES required. --
-- Locks in the conditional emission of the "defaults" key (only when --
-- Just) and the unconditional emission of persistent/transient. --
-- ------------------------------------------------------------------ --
describe "ClusterSettings JSON roundtrip" $ do
let singleton k v = HM.singleton k (Aeson.String v)
decodeAsObject :: Aeson.Value -> Maybe Aeson.Object
decodeAsObject (Aeson.Object o) = Just o
decodeAsObject _ = Nothing
it "roundtrips when defaults is Nothing (no defaults key emitted)" $ do
let cs =
ClusterSettings
{ clusterSettingsPersistent = singleton "cluster.routing.allocation.enable" "all",
clusterSettingsTransient = HM.empty,
clusterSettingsDefaults = Nothing
}
encoded = Aeson.encode cs
decoded = Aeson.decode' encoded :: Maybe ClusterSettings
decoded `shouldBe` Just cs
-- Confirm the defaults key is genuinely absent from the wire form.
let wireObject = Aeson.decode' encoded >>= decodeAsObject
wireObject `shouldSatisfy` maybe False (not . AKM.member "defaults")
it "roundtrips when defaults is Just (defaults key present, even if empty)" $ do
let cs =
ClusterSettings
{ clusterSettingsPersistent = HM.empty,
clusterSettingsTransient = HM.empty,
clusterSettingsDefaults = Just HM.empty
}
encoded = Aeson.encode cs
decoded = Aeson.decode' encoded :: Maybe ClusterSettings
decoded `shouldBe` Just cs
let wireObject = Aeson.decode' encoded >>= decodeAsObject
wireObject `shouldSatisfy` maybe False (AKM.member "defaults")
it "decodes the minimal ES response shape" $ do
let bytes = "{\"persistent\":{},\"transient\":{}}"
decoded = Aeson.decode' bytes :: Maybe ClusterSettings
decoded
`shouldBe` Just
( ClusterSettings
{ clusterSettingsPersistent = HM.empty,
clusterSettingsTransient = HM.empty,
clusterSettingsDefaults = Nothing
}
)
-- ------------------------------------------------------------------ --
-- ClusterSettingsUpdate ToJSON: pure, no ES required. --
-- Locks in the conditional emission of persistent/transient (only --
-- when Just) so a Nothing layer is omitted entirely, and that Null --
-- values survive encoding (clear semantics). --
-- ------------------------------------------------------------------ --
describe "ClusterSettingsUpdate ToJSON" $ do
it "defaultClusterSettingsUpdate encodes to the empty object" $
encode defaultClusterSettingsUpdate `shouldBe` "{}"
it "emits both layers when both are Just" $ do
let update =
ClusterSettingsUpdate
{ clusterSettingsUpdatePersistent = Just (HM.singleton "a" (String "p")),
clusterSettingsUpdateTransient = Just (HM.singleton "b" (String "t"))
}
encode update
`shouldBe` "{\"persistent\":{\"a\":\"p\"},\"transient\":{\"b\":\"t\"}}"
it "emits an empty object for a Just mempty layer (distinct from Nothing)" $ do
-- ES treats "persistent":{} and an absent persistent key
-- differently w.r.t. clearing, so the distinction must survive
-- encoding.
let update =
defaultClusterSettingsUpdate
{ clusterSettingsUpdatePersistent = Just mempty
}
encode update `shouldBe` "{\"persistent\":{}}"
it "omits Nothing layers and emits Just layers" $ do
let update =
ClusterSettingsUpdate
{ clusterSettingsUpdatePersistent =
Just (HM.singleton "cluster.routing.allocation.enable" (String "all")),
clusterSettingsUpdateTransient = Nothing
}
encode update
`shouldBe` "{\"persistent\":{\"cluster.routing.allocation.enable\":\"all\"}}"
it "emits only the transient layer when persistent is Nothing" $ do
let update =
defaultClusterSettingsUpdate
{ clusterSettingsUpdateTransient =
Just (HM.singleton "cluster.routing.allocation.enable" (String "none"))
}
encode update
`shouldBe` "{\"transient\":{\"cluster.routing.allocation.enable\":\"none\"}}"
it "round-trips Null values (clear semantics preserved)" $ do
let update =
defaultClusterSettingsUpdate
{ clusterSettingsUpdateTransient =
Just
( HM.singleton
"cluster.routing.allocation.disk.threshold.enabled"
Null
)
}
encode update
`shouldBe` "{\"transient\":{\"cluster.routing.allocation.disk.threshold.enabled\":null}}"
-- ------------------------------------------------------------------ --
-- clusterSettingsUpdateOptionsParams: pure URI rendering (no ES). --
-- Mirrors the GET counterpart but covers only the parameters PUT --
-- accepts (no include_defaults). --
-- ------------------------------------------------------------------ --
describe "clusterSettingsUpdateOptionsParams URI rendering" $ do
let normalize :: [(T.Text, Maybe T.Text)] -> [(T.Text, Maybe T.Text)]
normalize = L.sort
it "defaultClusterSettingsUpdateOptions emits no params" $
clusterSettingsUpdateOptionsParams defaultClusterSettingsUpdateOptions
`shouldBe` []
it "renders flat_settings as lowercase true/false" $ do
let opts = defaultClusterSettingsUpdateOptions {csuoFlatSettings = Just True}
clusterSettingsUpdateOptionsParams opts `shouldBe` [("flat_settings", Just "true")]
let opts' = defaultClusterSettingsUpdateOptions {csuoFlatSettings = Just False}
clusterSettingsUpdateOptionsParams opts' `shouldBe` [("flat_settings", Just "false")]
it "renders master_timeout as <n><suffix>" $ do
let opts = defaultClusterSettingsUpdateOptions {csuoMasterTimeout = Just (TimeUnitSeconds, 30)}
clusterSettingsUpdateOptionsParams opts `shouldBe` [("master_timeout", Just "30s")]
it "emits every param together when all are set" $ do
let opts =
defaultClusterSettingsUpdateOptions
{ csuoFlatSettings = Just True,
csuoMasterTimeout = Just (TimeUnitMilliseconds, 500)
}
normalize (clusterSettingsUpdateOptionsParams opts)
`shouldBe` [ ("flat_settings", Just "true"),
("master_timeout", Just "500ms")
]
-- ------------------------------------------------------------------ --
-- updateClusterSettings endpoint shape: pure checks against the --
-- BHRequest value; no live backend needed. Mirrors the putILMPolicy --
-- shape tests in Test.ILMSpec. --
-- ------------------------------------------------------------------ --
describe "updateClusterSettings endpoint shape" $ do
it "PUTs /_cluster/settings with no queries by default" $ do
let req = Common.updateClusterSettings defaultClusterSettingsUpdate
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_cluster", "settings"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "attaches the encoded update as the request body" $ do
let update =
defaultClusterSettingsUpdate
{ clusterSettingsUpdatePersistent =
Just (HM.singleton "cluster.routing.allocation.enable" (String "all"))
}
req = Common.updateClusterSettings update
bhRequestBody req `shouldBe` Just (encode update)
it "forwards flat_settings and master_timeout via updateClusterSettingsWith" $ do
let opts =
defaultClusterSettingsUpdateOptions
{ csuoFlatSettings = Just True,
csuoMasterTimeout = Just (TimeUnitSeconds, 30)
}
req = Common.updateClusterSettingsWith opts defaultClusterSettingsUpdate
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_cluster", "settings"]
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("flat_settings", Just "true"), ("master_timeout", Just "30s")]
-- ------------------------------------------------------------------ --
-- updateClusterSettings live round-trip: set a harmless transient --
-- setting, verify it landed, then clear it (PUT null). The bracket_ --
-- guarantees the clear runs even if an assertion fails mid-way, so --
-- cluster state is never left dirty. --
-- ------------------------------------------------------------------ --
describe "updateClusterSettings live round-trip" $ do
-- Only the transient layer is exercised live: it is cleared on a
-- full cluster restart, so a stuck/crashed test can never leave
-- persistent state behind. The persistent layer is covered by the
-- pure ToJSON tests above (it shares the encoder branch).
--
-- cluster.routing.allocation.enable is a core setting recognised on
-- every ES/OpenSearch cluster. Setting it transiently to its default
-- value "all" is a true no-op behaviourally, yet ES still records
-- the explicit assignment in the transient layer — which is exactly
-- what lets the test observe the write without perturbing the
-- cluster. The PUT null in the cleanup erases the transient entry.
let key = "cluster.routing.allocation.enable"
setUpdate =
defaultClusterSettingsUpdate
{ clusterSettingsUpdateTransient = Just (HM.singleton key (String "all"))
}
clearUpdate =
defaultClusterSettingsUpdate
{ clusterSettingsUpdateTransient = Just (HM.singleton key Null)
}
it "sets a transient setting, reads it back, then clears it"
$ withTestEnv
$ bracket_
(void $ Client.updateClusterSettings setUpdate)
(void $ Client.updateClusterSettings clearUpdate)
$ do
-- flat_settings=true so the transient map uses dotted keys
-- (cluster.routing.allocation.enable) rather than a nested
-- object tree — matching the flat lookup below.
let flat = defaultClusterSettingsOptions {csoFlatSettings = Just True}
beforeClear <- Client.getClusterSettingsWith flat
liftIO $
HM.lookup key (clusterSettingsTransient beforeClear)
`shouldBe` Just (String "all")
-- Explicitly clear mid-test so we can also assert the
-- post-clear state. The bracket_ cleanup is idempotent.
void $ Client.updateClusterSettings clearUpdate
afterClear <- Client.getClusterSettingsWith flat
liftIO $
HM.member key (clusterSettingsTransient afterClear)
`shouldBe` False