bloodhound-1.0.0.0: tests/Test/ClusterStatsSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.ClusterStatsSpec where
import Data.Aeson.KeyMap qualified as KM
import Data.Text qualified as T
import Database.Bloodhound.Common.Client qualified as Client
import Database.Bloodhound.Common.Types
import TestsUtils.Common
import TestsUtils.Import
spec :: Spec
spec = do
describe "cluster stats API" $ do
it "getClusterStats returns typed top-level fields" $
withTestEnv $ do
stats <- Client.getClusterStats
liftIO $ clusterStatsClusterName stats `shouldSatisfy` (not . T.null)
liftIO $ clusterStatsClusterUuid stats `shouldSatisfy` (not . T.null)
liftIO $ clusterStatsStatus stats `shouldSatisfy` (`elem` [ClusterHealthGreen, ClusterHealthYellow, ClusterHealthRed])
liftIO $ clusterStatsTimestamp stats `shouldSatisfy` (> 0)
it "exposes _nodes summary with total >= successful" $
withTestEnv $ do
stats <- Client.getClusterStats
let summary = clusterStatsNodesSummary stats
liftIO $ clusterStatsNodeSummaryTotal summary `shouldSatisfy` (>= 1)
liftIO $ clusterStatsNodeSummarySuccessful summary `shouldSatisfy` (>= 1)
liftIO $ clusterStatsNodeSummaryFailed summary `shouldSatisfy` (>= 0)
it "exposes indices count >= 0 and a versions list" $
withTestEnv $ do
stats <- Client.getClusterStats
let indices = clusterStatsIndices stats
liftIO $ clusterStatsIndicesCount indices `shouldSatisfy` (>= 0)
let versionStrings = clusterStatsIndexVersionVersion <$> clusterStatsIndicesVersions indices
liftIO $ versionStrings `shouldSatisfy` all (not . T.null)
it "exposes indices.shards summary with non-negative totals" $
withTestEnv $ do
stats <- Client.getClusterStats
let shards = clusterStatsIndicesShards (clusterStatsIndices stats)
liftIO $ clusterStatsShardsTotal shards `shouldSatisfy` (>= 0)
liftIO $ clusterStatsShardsPrimaries shards `shouldSatisfy` (>= 0)
it "preserves untyped indices sections as a JSON object" $
withTestEnv $ do
stats <- Client.getClusterStats
case clusterStatsIndicesOther (clusterStatsIndices stats) of
Object _ -> pure ()
other -> liftIO $ expectationFailure $ "expected indices object, got " <> show other
it "exposes nodes count total >= 1 and at least one version" $
withTestEnv $ do
stats <- Client.getClusterStats
let nodes = clusterStatsNodes stats
count = clusterStatsNodesCount nodes
liftIO $ clusterStatsNodeCountTotal count `shouldSatisfy` (>= 1)
liftIO $ clusterStatsNodesVersions nodes `shouldSatisfy` (not . null)
it "preserves untyped nodes sections as a JSON object" $
withTestEnv $ do
stats <- Client.getClusterStats
case clusterStatsNodesOther (clusterStatsNodes stats) of
Object _ -> pure ()
other -> liftIO $ expectationFailure $ "expected nodes object, got " <> show other
-- ------------------------------------------------------------------ --
-- Pure FromJSON/ToJSON round-trip (no ES required) --
-- ------------------------------------------------------------------ --
describe "ClusterStats JSON codec" $ do
let samplePayload :: Value
samplePayload =
object
[ "timestamp" .= (1718000000000 :: Int),
"cluster_name" .= ("bloodhound-test" :: Text),
"cluster_uuid" .= ("abc-123" :: Text),
"status" .= ("green" :: Text),
"_nodes"
.= object
[ "total" .= (1 :: Int),
"successful" .= (1 :: Int),
"failed" .= (0 :: Int)
],
"indices"
.= object
[ "count" .= (3 :: Int),
"shards"
.= object
[ "total" .= (6 :: Int),
"primaries" .= (3 :: Int),
"replication" .= (1.0 :: Double)
],
"docs" .= object ["count" .= (42 :: Int), "deleted" .= (1 :: Int)],
"store" .= object ["size_in_bytes" .= (2048 :: Int)],
"versions" .= ["8.17.0" :: Text],
"segments" .= object ["count" .= (12 :: Int)]
],
"nodes"
.= object
[ "count"
.= object
[ "total" .= (1 :: Int),
"data" .= (1 :: Int),
"master" .= (1 :: Int)
],
"versions" .= ["8.17.0" :: Text],
"jvm" .= object ["max_uptime_in_millis" .= (60000 :: Int)]
]
]
it "round-trips a representative ES payload without dropping untyped fields" $
case fromJSON @ClusterStats samplePayload of
Success decoded ->
case toJSON decoded of
Object reencoded ->
case fromJSON @ClusterStats (Object reencoded) of
Success again -> do
clusterStatsIndicesCount (clusterStatsIndices again) `shouldBe` 3
-- The verbatim 'segments' sub-object (not modelled as a
-- typed field) must survive the round-trip via
-- 'clusterStatsIndicesOther'.
case otherObject (clusterStatsIndices again) of
Just o
| KM.member "segments" o -> pure ()
_ -> expectationFailure "segments dropped from indices round-trip"
Error err -> expectationFailure ("re-decode failed: " <> err)
other -> expectationFailure ("re-encode produced non-object: " <> show other)
Error err -> expectationFailure ("initial decode failed: " <> err)
it "decodes the modern object-form of indices.versions" $ do
let payload =
object
[ "version" .= ("8.17.0" :: Text),
"index_count" .= (12 :: Int),
"primary_shard_count" .= (24 :: Int),
"total_primary_bytes" .= (4096 :: Int)
]
case fromJSON @ClusterStatsIndexVersion payload of
Success v -> do
clusterStatsIndexVersionVersion v `shouldBe` "8.17.0"
clusterStatsIndexVersionIndexCount v `shouldBe` Just 12
clusterStatsIndexVersionPrimaryShardCount v `shouldBe` Just 24
clusterStatsIndexVersionTotalPrimaryBytes v `shouldBe` Just 4096
Error err -> expectationFailure ("decode failed: " <> err)
it "decodes the legacy bare-string form of indices.versions" $ do
case fromJSON @ClusterStatsIndexVersion (String "7.10.0") of
Success v -> do
clusterStatsIndexVersionVersion v `shouldBe` "7.10.0"
clusterStatsIndexVersionIndexCount v `shouldBe` Nothing
clusterStatsIndexVersionPrimaryShardCount v `shouldBe` Nothing
clusterStatsIndexVersionTotalPrimaryBytes v `shouldBe` Nothing
Error err -> expectationFailure ("decode failed: " <> err)
it "captures nodes.count by-role entries beyond `total`" $ do
let payload =
object
[ "total" .= (1 :: Int),
"data" .= (1 :: Int),
"master" .= (1 :: Int),
"ingest" .= (0 :: Int)
]
case fromJSON @ClusterStatsNodeCount payload of
Success count -> do
clusterStatsNodeCountTotal count `shouldBe` 1
lookup "data" (clusterStatsNodeCountByRole count) `shouldBe` Just 1
lookup "master" (clusterStatsNodeCountByRole count) `shouldBe` Just 1
lookup "ingest" (clusterStatsNodeCountByRole count) `shouldBe` Just 0
Error err -> expectationFailure ("decode failed: " <> err)
it "decodes a minimal payload (missing optional fields)" $ do
let payload =
object
[ "cluster_name" .= ("x" :: Text),
"cluster_uuid" .= ("y" :: Text),
"status" .= ("yellow" :: Text)
]
case fromJSON @ClusterStats payload of
Success stats -> clusterStatsStatus stats `shouldBe` ClusterHealthYellow
Error err -> expectationFailure ("decode failed: " <> err)
-- | Project the @*Other@ 'Value' as a 'KM.KeyMap' when it carries an
-- 'Object'; used by the round-trip test to verify that untyped sections
-- are preserved through 'toJSON'.
otherObject :: ClusterStatsIndices -> Maybe (KM.KeyMap Value)
otherObject ci =
case clusterStatsIndicesOther ci of
Object o -> Just o
_ -> Nothing