HealthReportSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.HealthReportSpec (spec) where

import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.ElasticSearch9.Client qualified as ClientES9
import Database.Bloodhound.ElasticSearch9.Requests qualified as RequestsES9
import Database.Bloodhound.ElasticSearch9.Types qualified as ES9
import TestsUtils.Common
import TestsUtils.Import
import Prelude

------------------------------------------------------------------------------
-- Sample payloads (trimmed to the wire fields decoded by the types).
------------------------------------------------------------------------------

-- | A healthy cluster: green status, one green indicator whose subtype
-- adds an extra @details@ object that must survive in 'ES9.hiOther'.
sampleReportGreenBytes :: LBS.ByteString
sampleReportGreenBytes =
  "{\
  \  \"cluster_name\": \"my-cluster\",\n\
  \  \"status\": \"green\",\
  \  \"indicators\": {\
  \    \"master_is_stable\": {\
  \      \"status\": \"green\",\
  \      \"symptom\": \"The cluster has a healthy master node.\",\
  \      \"details\": {\"is_stable\": true}\
  \    }\
  \  }\
  \}"

-- | An unhealthy indicator carrying @impacts@ and @diagnosis@ (the fields
-- the server only populates when status is not green).
sampleIndicatorRedBytes :: LBS.ByteString
sampleIndicatorRedBytes =
  "{\
  \  \"status\": \"red\",\
  \  \"symptom\": \"Disk usage is high.\",\
  \  \"impacts\": [\
  \    {\
  \      \"description\": \"Reduced indexing capacity.\",\
  \      \"id\": \"disk@ingest-disabled\",\
  \      \"impact_areas\": [\"ingest\"],\
  \      \"severity\": 1\
  \    }\
  \  ],\
  \  \"diagnosis\": [\
  \    {\
  \      \"id\": \"disk@high-disk-watermark\",\
  \      \"action\": \"Free up disk space.\",\
  \      \"cause\": \"Disk watermark exceeded.\",\
  \      \"help_url\": \"https://www.elastic.co/guide/\",\
  \      \"affected_resources\": {\
  \        \"nodes\": [{\"node_id\": \"n1\", \"name\": \"node-1\"}]\
  \      }\
  \    }\
  \  ]\
  \}"

spec :: Spec
spec = do
  --------------------------------------------------------------------------
  -- JSON (de)serialisation
  --------------------------------------------------------------------------
  describe "HealthReport JSON" $ do
    it "decodes a green report with its indicators map" $ do
      let decoded = eitherDecode sampleReportGreenBytes :: Either String ES9.HealthReport
      decoded `shouldSatisfy` isRight
      let Right report = decoded
      ES9.hrClusterName report `shouldBe` "my-cluster"
      ES9.hrStatus report `shouldBe` Just ES9.HealthReportStatusGreen
      M.size (ES9.hrIndicators report) `shouldBe` 1

    it "captures subtype-specific fields in hiOther" $ do
      let decoded = eitherDecode sampleReportGreenBytes :: Either String ES9.HealthReport
          Right report = decoded
          Just indicator = M.lookup "master_is_stable" (ES9.hrIndicators report)
      ES9.hiStatus indicator `shouldBe` ES9.HealthReportStatusGreen
      ES9.hiOther indicator `shouldSatisfy` isJust

    it "round-trips the known fields through encode/decode" $ do
      let decoded = eitherDecode sampleReportGreenBytes :: Either String ES9.HealthReport
      decoded `shouldSatisfy` isRight
      let Right report = decoded
      let reDecoded = eitherDecode (encode report) :: Either String ES9.HealthReport
      reDecoded `shouldSatisfy` isRight
      -- The known fields survive a round trip.
      let Right reReport = reDecoded
      ES9.hrClusterName reReport `shouldBe` ES9.hrClusterName report
      ES9.hrStatus reReport `shouldBe` ES9.hrStatus report

    it "preserves the hiOther catch-all across encode/decode" $ do
      -- The catch-all is the module's headline invariant: subtype-specific
      -- fields must survive a round trip. A wrong X.union bias would lose
      -- them, so this guards it explicitly.
      let decoded = eitherDecode sampleReportGreenBytes :: Either String ES9.HealthReport
          Right report = decoded
          Just indicator = M.lookup "master_is_stable" (ES9.hrIndicators report)
      let reDecoded = eitherDecode (encode report) :: Either String ES9.HealthReport
          Right reReport = reDecoded
          Just reIndicator = M.lookup "master_is_stable" (ES9.hrIndicators reReport)
      ES9.hiOther reIndicator `shouldSatisfy` isJust
      ES9.hiOther reIndicator `shouldBe` ES9.hiOther indicator

  describe "HealthIndicator JSON" $ do
    it "decodes impacts and diagnosis on a red indicator" $ do
      let decoded = eitherDecode sampleIndicatorRedBytes :: Either String ES9.HealthIndicator
      decoded `shouldSatisfy` isRight
      let Right indicator = decoded
      ES9.hiStatus indicator `shouldBe` ES9.HealthReportStatusRed
      length <$> ES9.hiImpacts indicator `shouldBe` Just 1
      length <$> ES9.hiDiagnosis indicator `shouldBe` Just 1

    it "decodes the HealthReportStatus enum both ways" $ do
      ES9.healthReportStatusToText ES9.HealthReportStatusRed `shouldBe` "red"
      ES9.healthReportStatusFromText "unavailable"
        `shouldBe` Just ES9.HealthReportStatusUnavailable

  --------------------------------------------------------------------------
  -- Endpoint shape
  --------------------------------------------------------------------------
  describe "getHealthReport endpoint shape" $ do
    it "GETs /_health_report when given Nothing" $ do
      let req = RequestsES9.getHealthReport Nothing
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_health_report"]

    it "GETs /_health_report/{feature} when given features" $ do
      let req = RequestsES9.getHealthReport (Just ["disk"])
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_health_report", "disk"]

    it "joins multiple features with a comma" $ do
      let req = RequestsES9.getHealthReport (Just ["disk", "ilm"])
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_health_report", "disk,ilm"]

    it "uses the GET method" $ do
      let req = RequestsES9.getHealthReport Nothing
      bhRequestMethod req `shouldBe` "GET"

    it "carries no request body" $ do
      let req = RequestsES9.getHealthReport Nothing
      bhRequestBody req `shouldBe` Nothing

    it "carries no query string by default" $ do
      let req = RequestsES9.getHealthReport Nothing
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "renders verbose via getHealthReportWith" $ do
      let opts = ES9.defaultHealthReportOptions {ES9.hroVerbose = Just False}
          req = RequestsES9.getHealthReportWith opts Nothing
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("verbose", Just "false")]

  --------------------------------------------------------------------------
  -- Live integration (ES9 only).
  --------------------------------------------------------------------------
  backendSpecific
    [ElasticSearch9]
    $ describe "Health report API (live integration)"
    $ do
      it "getHealthReport Nothing returns a parseable response" $
        withTestEnv $ do
          result <- tryEsError $ ClientES9.getHealthReport Nothing
          liftIO $
            case result of
              Left e
                | endpointMissing e ->
                    pendingWith "health report requires Elasticsearch 9+"
              _ -> pure ()
          case result of
            Left e -> liftIO $ expectationFailure $ "getHealthReport failed: " <> show e
            Right report ->
              liftIO $
                ES9.hrClusterName report `shouldSatisfy` (not . T.null)

-- | Detect the @no handler found for uri@shape returned by Elasticsearch
-- when an endpoint isn't registered on this version. Used to mark the
-- live tests as 'pendingWith' rather than failing.
endpointMissing :: EsError -> Bool
endpointMissing e =
  "no handler found" `T.isInfixOf` T.toLower (errorMessage e)