bloodhound-1.0.0.0: tests/Test/MigrationSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.MigrationSpec (spec) where
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Map.Strict qualified as M
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.Common.Client qualified as CommonClient
import Database.Bloodhound.Common.Requests qualified as Common
import System.Environment (lookupEnv)
import TestsUtils.Common
import TestsUtils.Import
import Prelude
------------------------------------------------------------------------------
-- Sample payloads (sourced from the ES reference docs and trimmed for
-- the wire fields actually decoded by the Migration types).
------------------------------------------------------------------------------
-- | Cluster-level deprecation with @details@ populated and
-- @resolve_during_rolling_upgrade@ / @_meta@ omitted (matches the
-- official ES example response).
sampleClusterDeprecationBytes :: LBS.ByteString
sampleClusterDeprecationBytes =
"{\
\ \"level\": \"critical\",\
\ \"message\": \"Cluster name cannot contain ':'\",\
\ \"url\": \"https://www.elastic.co/guide/en/elasticsearch/reference/7.0/breaking-changes-7.0.html#_literal_literal_is_no_longer_allowed_in_cluster_name\",\
\ \"details\": \"This cluster is named [mycompany:logging], which contains the illegal character ':'.\"\
\}"
-- | Full @GET /_migration/deprecations@ response matching the ES
-- reference example: cluster-level critical warning, empty @node@ list,
-- one index-level warning under @logs:apache@, empty @ml@ list. The
-- index name contains a colon, which 'IndexName' would reject — proving
-- why the map key type is 'Text'.
sampleDeprecationsResponseBytes :: LBS.ByteString
sampleDeprecationsResponseBytes =
"{\
\ \"cluster_settings\": [\
\ {\
\ \"level\": \"critical\",\
\ \"message\": \"Cluster name cannot contain ':'\",\
\ \"url\": \"https://www.elastic.co/guide/en/elasticsearch/reference/7.0/breaking-changes-7.0.html#_literal_literal_is_no_longer_allowed_in_cluster_name\",\
\ \"details\": \"This cluster is named [mycompany:logging], which contains the illegal character ':'.\"\
\ }\
\ ],\
\ \"node_settings\": [],\
\ \"index_settings\": {\
\ \"logs:apache\": [\
\ {\
\ \"level\": \"warning\",\
\ \"message\": \"Index name cannot contain ':'\",\
\ \"url\": \"https://www.elastic.co/guide/en/elasticsearch/reference/7.0/breaking-changes-7.0.html#_literal_literal_is_no_longer_allowed_in_index_name\",\
\ \"details\": \"This index is named [logs:apache], which contains the illegal character ':'.\",\
\ \"resolve_during_rolling_upgrade\": true\
\ }\
\ ]\
\ },\
\ \"ml_settings\": []\
\}"
-- | Minimal @GET /_migration/system_features@ response: two features,
-- both @NO_MIGRATION_NEEDED@, empty @indices@ arrays (matches the
-- official ES example shape).
sampleSystemFeaturesResponseBytes :: LBS.ByteString
sampleSystemFeaturesResponseBytes =
"{\
\ \"migration_status\": \"NO_MIGRATION_NEEDED\",\
\ \"features\": [\
\ {\
\ \"feature_name\": \"async_search\",\
\ \"minimum_index_version\": \"8100099\",\
\ \"migration_status\": \"NO_MIGRATION_NEEDED\",\
\ \"indices\": []\
\ },\
\ {\
\ \"feature_name\": \"enrich\",\
\ \"minimum_index_version\": \"8100099\",\
\ \"migration_status\": \"NO_MIGRATION_NEEDED\",\
\ \"indices\": []\
\ }\
\ ]\
\}"
------------------------------------------------------------------------------
-- Spec
------------------------------------------------------------------------------
spec :: Spec
spec = describe "Migration API" $ do
--------------------------------------------------------------------------
-- DeprecationLevel
--------------------------------------------------------------------------
describe "DeprecationLevel JSON" $ do
it "round-trips each constructor through its wire string" $ do
encode DeprecationLevelNone `shouldBe` "\"none\""
encode DeprecationLevelInfo `shouldBe` "\"info\""
encode DeprecationLevelWarning `shouldBe` "\"warning\""
encode DeprecationLevelCritical `shouldBe` "\"critical\""
it "decodes each wire string back to the constructor" $ do
decode "\"none\"" `shouldBe` Just DeprecationLevelNone
decode "\"info\"" `shouldBe` Just DeprecationLevelInfo
decode "\"warning\"" `shouldBe` Just DeprecationLevelWarning
decode "\"critical\"" `shouldBe` Just DeprecationLevelCritical
it "rejects an unknown level" $ do
(decode "\"panic\"" :: Maybe DeprecationLevel) `shouldBe` Nothing
it "rejects a non-string value" $ do
(decode "42" :: Maybe DeprecationLevel) `shouldBe` Nothing
--------------------------------------------------------------------------
-- Deprecation
--------------------------------------------------------------------------
describe "Deprecation JSON" $ do
it "decodes the canonical ES example (no rolling_upgrade / _meta)" $ do
let Just decoded = decode sampleClusterDeprecationBytes :: Maybe Deprecation
deprecationLevel decoded `shouldBe` DeprecationLevelCritical
deprecationMessage decoded `shouldBe` "Cluster name cannot contain ':'"
deprecationDetails decoded `shouldBe` Just "This cluster is named [mycompany:logging], which contains the illegal character ':'."
deprecationResolveDuringRollingUpgrade decoded `shouldBe` Nothing
deprecationMeta decoded `shouldBe` Nothing
it "decodes a deprecation that carries rolling_upgrade and _meta" $ do
let bytes =
"{\
\ \"level\": \"warning\",\
\ \"message\": \"m\",\
\ \"url\": \"u\",\
\ \"resolve_during_rolling_upgrade\": true,\
\ \"_meta\": {\"k\": 1}\
\}"
Just decoded = decode bytes :: Maybe Deprecation
deprecationResolveDuringRollingUpgrade decoded `shouldBe` Just True
deprecationMeta decoded `shouldBe` Just (object ["k" .= (1 :: Int)])
it "round-trips through ToJSON/FromJSON" $ do
let d =
Deprecation
{ deprecationLevel = DeprecationLevelWarning,
deprecationMessage = "m",
deprecationUrl = "u",
deprecationDetails = Just "d",
deprecationResolveDuringRollingUpgrade = Just False,
deprecationMeta = Nothing
}
(decode . encode) d `shouldBe` Just d
it "omits Nothing fields from ToJSON output" $ do
let d =
Deprecation
{ deprecationLevel = DeprecationLevelInfo,
deprecationMessage = "m",
deprecationUrl = "u",
deprecationDetails = Nothing,
deprecationResolveDuringRollingUpgrade = Nothing,
deprecationMeta = Nothing
}
encode d `shouldBe` "{\"level\":\"info\",\"message\":\"m\",\"url\":\"u\"}"
it "rejects a response missing the level field" $ do
(decode "{\"message\":\"m\",\"url\":\"u\"}" :: Maybe Deprecation)
`shouldBe` Nothing
it "rejects a response with an unknown level value" $ do
(decode "{\"level\":\"panic\",\"message\":\"m\",\"url\":\"u\"}" :: Maybe Deprecation)
`shouldBe` Nothing
it "rejects a non-object body" $ do
(decode "[1,2,3]" :: Maybe Deprecation) `shouldBe` Nothing
--------------------------------------------------------------------------
-- MigrationDeprecations
--------------------------------------------------------------------------
describe "MigrationDeprecations JSON" $ do
it "decodes the canonical ES example response" $ do
let Just decoded = decode sampleDeprecationsResponseBytes :: Maybe MigrationDeprecations
migrationDeprecationsClusterSettings decoded
`shouldBe` Just
[ Deprecation
{ deprecationLevel = DeprecationLevelCritical,
deprecationMessage = "Cluster name cannot contain ':'",
deprecationUrl = "https://www.elastic.co/guide/en/elasticsearch/reference/7.0/breaking-changes-7.0.html#_literal_literal_is_no_longer_allowed_in_cluster_name",
deprecationDetails = Just "This cluster is named [mycompany:logging], which contains the illegal character ':'.",
deprecationResolveDuringRollingUpgrade = Nothing,
deprecationMeta = Nothing
}
]
migrationDeprecationsNodeSettings decoded `shouldBe` Just []
migrationDeprecationsMlSettings decoded `shouldBe` Just []
migrationDeprecationsIndexSettings decoded
`shouldBe` Just
( M.fromList
[ ( "logs:apache",
[ Deprecation
{ deprecationLevel = DeprecationLevelWarning,
deprecationMessage = "Index name cannot contain ':'",
deprecationUrl = "https://www.elastic.co/guide/en/elasticsearch/reference/7.0/breaking-changes-7.0.html#_literal_literal_is_no_longer_allowed_in_index_name",
deprecationDetails = Just "This index is named [logs:apache], which contains the illegal character ':'.",
deprecationResolveDuringRollingUpgrade = Just True,
deprecationMeta = Nothing
}
]
)
]
)
migrationDeprecationsDataStreams decoded `shouldBe` Nothing
migrationDeprecationsTemplates decoded `shouldBe` Nothing
migrationDeprecationsILMPolicies decoded `shouldBe` Nothing
it "tolerates a response with only some sections present" $ do
let Just decoded =
decode "{\"cluster_settings\":[]}" :: Maybe MigrationDeprecations
migrationDeprecationsClusterSettings decoded `shouldBe` Just []
migrationDeprecationsNodeSettings decoded `shouldBe` Nothing
it "tolerates an empty object" $ do
let Just decoded = decode "{}" :: Maybe MigrationDeprecations
migrationDeprecationsClusterSettings decoded `shouldBe` Nothing
it "decodes data_streams / templates / ilm_policies maps" $ do
let bytes =
"{\
\ \"data_streams\": {\"logs-app\": [{\"level\":\"info\",\"message\":\"m\",\"url\":\"u\"}]},\
\ \"templates\": {\"component-tpl\": [{\"level\":\"warning\",\"message\":\"m\",\"url\":\"u\"}]},\
\ \"ilm_policies\": {\"my-policy\": [{\"level\":\"critical\",\"message\":\"m\",\"url\":\"u\"}]}\
\}"
Just decoded = decode bytes :: Maybe MigrationDeprecations
expectedEntry lvl =
[ Deprecation
{ deprecationLevel = lvl,
deprecationMessage = "m",
deprecationUrl = "u",
deprecationDetails = Nothing,
deprecationResolveDuringRollingUpgrade = Nothing,
deprecationMeta = Nothing
}
]
migrationDeprecationsDataStreams decoded
`shouldBe` Just (M.fromList [("logs-app", expectedEntry DeprecationLevelInfo)])
migrationDeprecationsTemplates decoded
`shouldBe` Just (M.fromList [("component-tpl", expectedEntry DeprecationLevelWarning)])
migrationDeprecationsILMPolicies decoded
`shouldBe` Just (M.fromList [("my-policy", expectedEntry DeprecationLevelCritical)])
it "round-trips through ToJSON/FromJSON (omitNulls drops empty arrays)" $ do
-- 'omitNulls' drops empty arrays from the encoded JSON, so
-- @Just []@ surfaces as @Nothing@ after a round-trip. This matches
-- the SLM / ILM modules' treatment of empty list fields.
let d =
MigrationDeprecations
{ migrationDeprecationsClusterSettings = Just [],
migrationDeprecationsNodeSettings = Nothing,
migrationDeprecationsMlSettings = Nothing,
migrationDeprecationsIndexSettings = Nothing,
migrationDeprecationsDataStreams = Nothing,
migrationDeprecationsTemplates = Nothing,
migrationDeprecationsILMPolicies = Nothing
}
(decode . encode) d
`shouldBe` Just
( MigrationDeprecations
{ migrationDeprecationsClusterSettings = Nothing,
migrationDeprecationsNodeSettings = Nothing,
migrationDeprecationsMlSettings = Nothing,
migrationDeprecationsIndexSettings = Nothing,
migrationDeprecationsDataStreams = Nothing,
migrationDeprecationsTemplates = Nothing,
migrationDeprecationsILMPolicies = Nothing
}
)
it "round-trips a non-empty cluster_settings list unchanged" $ do
let entry =
Deprecation
{ deprecationLevel = DeprecationLevelInfo,
deprecationMessage = "m",
deprecationUrl = "u",
deprecationDetails = Nothing,
deprecationResolveDuringRollingUpgrade = Nothing,
deprecationMeta = Nothing
}
d =
MigrationDeprecations
{ migrationDeprecationsClusterSettings = Just [entry],
migrationDeprecationsNodeSettings = Nothing,
migrationDeprecationsMlSettings = Nothing,
migrationDeprecationsIndexSettings = Nothing,
migrationDeprecationsDataStreams = Nothing,
migrationDeprecationsTemplates = Nothing,
migrationDeprecationsILMPolicies = Nothing
}
(decode . encode) d `shouldBe` Just d
it "rejects a non-object response" $ do
(decode "[]" :: Maybe MigrationDeprecations) `shouldBe` Nothing
--------------------------------------------------------------------------
-- FeatureMigrationStatus
--------------------------------------------------------------------------
describe "FeatureMigrationStatus JSON" $ do
it "round-trips each constructor through its wire string" $ do
encode FeatureMigrationStatusNoMigrationNeeded `shouldBe` "\"NO_MIGRATION_NEEDED\""
encode FeatureMigrationStatusMigrationNeeded `shouldBe` "\"MIGRATION_NEEDED\""
encode FeatureMigrationStatusInProgress `shouldBe` "\"IN_PROGRESS\""
encode FeatureMigrationStatusError `shouldBe` "\"ERROR\""
it "decodes each wire string back to the constructor" $ do
decode "\"NO_MIGRATION_NEEDED\"" `shouldBe` Just FeatureMigrationStatusNoMigrationNeeded
decode "\"MIGRATION_NEEDED\"" `shouldBe` Just FeatureMigrationStatusMigrationNeeded
decode "\"IN_PROGRESS\"" `shouldBe` Just FeatureMigrationStatusInProgress
decode "\"ERROR\"" `shouldBe` Just FeatureMigrationStatusError
it "rejects an unknown status" $ do
(decode "\"PENDING\"" :: Maybe FeatureMigrationStatus) `shouldBe` Nothing
it "rejects a non-string value" $ do
(decode "42" :: Maybe FeatureMigrationStatus) `shouldBe` Nothing
--------------------------------------------------------------------------
-- FeatureUpgradeIndex
--------------------------------------------------------------------------
describe "FeatureUpgradeIndex JSON" $ do
it "decodes a healthy entry (no failure_cause)" $ do
let Just decoded =
decode "{\"index\":\".async-search\",\"version\":\"v7.10.0\"}" ::
Maybe FeatureUpgradeIndex
featureUpgradeIndexIndex decoded `shouldBe` ".async-search"
featureUpgradeIndexVersion decoded `shouldBe` "v7.10.0"
featureUpgradeIndexFailureCause decoded `shouldBe` Nothing
it "decodes an entry that carries a failure_cause blob" $ do
let bytes =
"{\
\ \"index\": \"broken\",\
\ \"version\": \"v1\",\
\ \"failure_cause\": {\"type\":\"illegal_argument\",\"reason\":\"nope\"}\
\}"
Just decoded = decode bytes :: Maybe FeatureUpgradeIndex
featureUpgradeIndexFailureCause decoded
`shouldBe` Just
(object ["type" .= String "illegal_argument", "reason" .= String "nope"])
it "round-trips through ToJSON/FromJSON" $ do
let i =
FeatureUpgradeIndex
{ featureUpgradeIndexIndex = "ix",
featureUpgradeIndexVersion = "v1",
featureUpgradeIndexFailureCause = Nothing
}
(decode . encode) i `shouldBe` Just i
it "rejects a response missing the index field" $ do
(decode "{\"version\":\"v1\"}" :: Maybe FeatureUpgradeIndex)
`shouldBe` Nothing
--------------------------------------------------------------------------
-- FeatureUpgradeInfo
--------------------------------------------------------------------------
describe "FeatureUpgradeInfo JSON" $ do
it "decodes a no-migration-needed feature with empty indices" $ do
let Just decoded =
decode
"{\
\ \"feature_name\": \"async_search\",\
\ \"minimum_index_version\": \"8100099\",\
\ \"migration_status\": \"NO_MIGRATION_NEEDED\",\
\ \"indices\": []\
\}" ::
Maybe FeatureUpgradeInfo
featureUpgradeInfoFeatureName decoded `shouldBe` "async_search"
featureUpgradeInfoMinimumIndexVersion decoded `shouldBe` "8100099"
featureUpgradeInfoMigrationStatus decoded `shouldBe` FeatureMigrationStatusNoMigrationNeeded
featureUpgradeInfoIndices decoded `shouldBe` []
it "tolerates a missing indices field (defaults to empty list)" $ do
let Just decoded =
decode
"{\
\ \"feature_name\": \"enrich\",\
\ \"minimum_index_version\": \"0\",\
\ \"migration_status\": \"MIGRATION_NEEDED\"\
\}" ::
Maybe FeatureUpgradeInfo
featureUpgradeInfoIndices decoded `shouldBe` []
it "decodes a feature that still has indices to migrate" $ do
let bytes =
"{\
\ \"feature_name\": \"fleet\",\
\ \"minimum_index_version\": \"8080099\",\
\ \"migration_status\": \"IN_PROGRESS\",\
\ \"indices\": [\
\ {\"index\":\".fleet-actions-000001\",\"version\":\"v7.17.0\"},\
\ {\"index\":\".fleet-actions-000002\",\"version\":\"v8.0.0\",\"failure_cause\":{\"type\":\"x\",\"reason\":\"y\"}}\
\ ]\
\}"
Just decoded = decode bytes :: Maybe FeatureUpgradeInfo
indices = featureUpgradeInfoIndices decoded
secondIdx = case indices of
(_ : y : _) -> y
_ -> error "expected two indices"
featureUpgradeInfoMigrationStatus decoded `shouldBe` FeatureMigrationStatusInProgress
length indices `shouldBe` 2
featureUpgradeIndexFailureCause secondIdx `shouldBe` Just (object ["type" .= String "x", "reason" .= String "y"])
it "round-trips through ToJSON/FromJSON" $ do
let info =
FeatureUpgradeInfo
{ featureUpgradeInfoFeatureName = "fleet",
featureUpgradeInfoMinimumIndexVersion = "0",
featureUpgradeInfoMigrationStatus = FeatureMigrationStatusError,
featureUpgradeInfoIndices = []
}
(decode . encode) info `shouldBe` Just info
it "rejects a response missing migration_status" $ do
(decode "{\"feature_name\":\"x\",\"minimum_index_version\":\"0\"}" :: Maybe FeatureUpgradeInfo)
`shouldBe` Nothing
--------------------------------------------------------------------------
-- FeatureUpgradeStatus
--------------------------------------------------------------------------
describe "FeatureUpgradeStatus JSON" $ do
it "decodes the canonical ES example response" $ do
let Just decoded = decode sampleSystemFeaturesResponseBytes :: Maybe FeatureUpgradeStatus
featureUpgradeStatusMigrationStatus decoded `shouldBe` FeatureMigrationStatusNoMigrationNeeded
length (featureUpgradeStatusFeatures decoded) `shouldBe` 2
featureUpgradeInfoFeatureName (head (featureUpgradeStatusFeatures decoded))
`shouldBe` "async_search"
it "tolerates a missing features field (defaults to empty list)" $ do
let Just decoded = decode "{\"migration_status\":\"NO_MIGRATION_NEEDED\"}" :: Maybe FeatureUpgradeStatus
featureUpgradeStatusFeatures decoded `shouldBe` []
it "round-trips through ToJSON/FromJSON" $ do
let s =
FeatureUpgradeStatus
{ featureUpgradeStatusMigrationStatus = FeatureMigrationStatusNoMigrationNeeded,
featureUpgradeStatusFeatures = []
}
(decode . encode) s `shouldBe` Just s
it "rejects a response missing migration_status" $ do
(decode "{\"features\":[]}" :: Maybe FeatureUpgradeStatus)
`shouldBe` Nothing
--------------------------------------------------------------------------
-- Endpoint shape tests
--------------------------------------------------------------------------
describe "getMigrationDeprecations endpoint shape" $ do
it "GETs /_migration/deprecations when given Nothing" $ do
let req = Common.getMigrationDeprecations Nothing
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_migration", "deprecations"]
it "GETs /{index}/_migration/deprecations when given a Just index" $ do
let req = Common.getMigrationDeprecations (Just [qqIndexName|logs|])
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs", "_migration", "deprecations"]
it "uses the GET method" $ do
let req = Common.getMigrationDeprecations Nothing
bhRequestMethod req `shouldBe` "GET"
it "carries no request body" $ do
let req = Common.getMigrationDeprecations Nothing
bhRequestBody req `shouldBe` Nothing
it "carries no query string for either variant" $ do
let reqAll = Common.getMigrationDeprecations Nothing
reqOne = Common.getMigrationDeprecations (Just [qqIndexName|logs|])
getRawEndpointQueries (bhRequestEndpoint reqAll) `shouldBe` []
getRawEndpointQueries (bhRequestEndpoint reqOne) `shouldBe` []
describe "getSystemFeatures endpoint shape" $ do
let req = Common.getSystemFeatures
it "GETs /_migration/system_features" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_migration", "system_features"]
it "uses the GET method" $ do
bhRequestMethod req `shouldBe` "GET"
it "carries no request body" $ do
bhRequestBody req `shouldBe` Nothing
it "carries no query string" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "upgradeSystemFeatures endpoint shape" $ do
let req = Common.upgradeSystemFeatures
it "POSTs /_migration/system_features" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_migration", "system_features"]
it "uses the POST method" $ do
bhRequestMethod req `shouldBe` "POST"
it "sends an empty body" $ do
bhRequestBody req `shouldBe` Just ""
it "carries no query string" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
--------------------------------------------------------------------------
-- Live integration (gated on ES backends; mutating POST further gated
-- behind ES_TEST_RUN_MUTATING so cluster state is not perturbed by
-- default).
--------------------------------------------------------------------------
backendSpecific
[ElasticSearch7, ElasticSearch8, ElasticSearch9]
$ describe "Migration API (live integration)"
$ do
it "getMigrationDeprecations returns a parseable response" $
withTestEnv $ do
result <- CommonClient.getMigrationDeprecations Nothing
liftIO $
migrationDeprecationsClusterSettings result
`shouldSatisfy` (const True :: Maybe [Deprecation] -> Bool)
it "getSystemFeatures returns a parseable response" $
withTestEnv $ do
result <- CommonClient.getSystemFeatures
liftIO $
featureUpgradeStatusMigrationStatus result
`shouldSatisfy` (const True :: FeatureMigrationStatus -> Bool)
it "upgradeSystemFeatures returns Acknowledged when ES_TEST_RUN_MUTATING=true" $
withTestEnv $ do
enabled <- liftIO $ lookupEnv "ES_TEST_RUN_MUTATING"
case enabled of
Just "true" -> do
ack <- CommonClient.upgradeSystemFeatures
liftIO $ isAcknowledged ack `shouldBe` True
_ ->
liftIO $
pendingWith
"skipped: set ES_TEST_RUN_MUTATING=true to run this mutating test"