ResolveClusterSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.ResolveClusterSpec (spec) where

import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Map.Strict qualified as M
import Data.Text (Text)
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).
------------------------------------------------------------------------------

-- | Per-cluster entry with only the two required fields, as returned by
-- the bare @GET /_resolve/cluster@ form (no index matching).
sampleInfoMinimalBytes :: LBS.ByteString
sampleInfoMinimalBytes =
  "{\
  \  \"connected\": true,\
  \  \"skip_unavailable\": false\
  \}"

-- | Per-cluster entry with every optional field populated, as returned
-- when an index expression is supplied and the remote is recent enough
-- to report a version.
sampleInfoFullBytes :: LBS.ByteString
sampleInfoFullBytes =
  "{\
  \  \"connected\": true,\
  \  \"skip_unavailable\": false,\
  \  \"matching_indices\": true,\
  \  \"error\": \"authorization error\",\n\
  \  \"version\": {\
  \    \"build_flavor\": \"default\",\
  \    \"minimum_index_compatibility_version\": \"8.0.0\",\
  \    \"minimum_wire_compatibility_version\": \"8.0.0\",\
  \    \"number\": \"9.0.0\"\
  \  }\
  \}"

-- | Full @GET /_resolve/cluster@ response: a map keyed by cluster alias,
-- with the querying cluster under @"(local)"@ and one remote cluster.
sampleResponseBytes :: LBS.ByteString
sampleResponseBytes =
  "{\
  \  \"(local)\": {\
  \    \"connected\": true,\
  \    \"skip_unavailable\": false\
  \  },\
  \  \"remote_cluster\": {\
  \    \"connected\": true,\
  \    \"skip_unavailable\": true,\
  \    \"matching_indices\": false,\
  \    \"version\": {\
  \      \"build_flavor\": \"default\",\
  \      \"minimum_index_compatibility_version\": \"8.0.0\",\
  \      \"minimum_wire_compatibility_version\": \"8.0.0\",\
  \      \"number\": \"9.0.0\"\
  \    }\
  \  }\
  \}"

spec :: Spec
spec = do
  --------------------------------------------------------------------------
  -- JSON (de)serialisation
  --------------------------------------------------------------------------
  describe "ResolveClusterInfo JSON" $ do
    it "decodes the minimal two-field form" $ do
      let decoded = eitherDecode sampleInfoMinimalBytes :: Either String ES9.ResolveClusterInfo
      decoded `shouldSatisfy` isRight
      let Right info = decoded
      ES9.rciConnected info `shouldBe` True
      ES9.rciSkipUnavailable info `shouldBe` False
      ES9.rciMatchingIndices info `shouldBe` Nothing
      ES9.rciVersion info `shouldBe` Nothing

    it "decodes the full form with version and matching_indices" $ do
      let decoded = eitherDecode sampleInfoFullBytes :: Either String ES9.ResolveClusterInfo
      decoded `shouldSatisfy` isRight
      let Right info = decoded
      ES9.rciMatchingIndices info `shouldBe` Just True
      ES9.rciError info `shouldBe` Just "authorization error"
      ES9.rcvNumber <$> ES9.rciVersion info `shouldBe` Just "9.0.0"

    it "round-trips through encode/decode" $ do
      let decoded = eitherDecode sampleInfoFullBytes :: Either String ES9.ResolveClusterInfo
      decoded `shouldSatisfy` isRight
      let Right info = decoded
      eitherDecode (encode info) `shouldBe` Right info

  describe "ResolveClusterResponse JSON" $ do
    it "decodes a map keyed by cluster alias" $ do
      let decoded = eitherDecode sampleResponseBytes :: Either String ES9.ResolveClusterResponse
      decoded `shouldSatisfy` isRight
      let Right resp = decoded
      let entries = ES9.resolveClusterResponseEntries resp
      M.size entries `shouldBe` 2
      M.member "(local)" entries `shouldBe` True
      M.member "remote_cluster" entries `shouldBe` True

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

    it "GETs /_resolve/cluster/{name} when given patterns" $ do
      let req = RequestsES9.resolveCluster (Just ["logs-*"])
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_resolve", "cluster", "logs-*"]

    it "joins multiple patterns with a comma" $ do
      let req = RequestsES9.resolveCluster (Just ["a", "b"])
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_resolve", "cluster", "a,b"]

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

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

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

    it "renders expand_wildcards via resolveClusterWith" $ do
      let opts =
            ES9.defaultResolveClusterOptions
              { ES9.rcoExpandWildcards =
                  Just (ExpandWildcardsOpen :| [ExpandWildcardsHidden])
              }
          req = RequestsES9.resolveClusterWith opts (Just ["logs-*"])
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("expand_wildcards", Just "open,hidden")]

    it "renders ignore_throttled via resolveClusterWith" $ do
      let opts =
            ES9.defaultResolveClusterOptions
              { ES9.rcoIgnoreThrottled = Just True
              }
          req = RequestsES9.resolveClusterWith opts (Just ["logs-*"])
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("ignore_throttled", Just "true")]

    it "renders ignore_throttled=false when set to False" $ do
      let opts =
            ES9.defaultResolveClusterOptions
              { ES9.rcoIgnoreThrottled = Just False
              }
          req = RequestsES9.resolveClusterWith opts (Just ["logs-*"])
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("ignore_throttled", Just "false")]

    it "omits ignore_throttled when Nothing (default)" $ do
      let req = RequestsES9.resolveClusterWith ES9.defaultResolveClusterOptions (Just ["logs-*"])
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

  --------------------------------------------------------------------------
  -- Live integration (ES9 only).
  --------------------------------------------------------------------------
  backendSpecific
    [ElasticSearch9]
    $ describe "Resolve cluster API (live integration)"
    $ do
      it "resolveCluster with an index pattern returns the local cluster" $
        withTestEnv $ do
          -- 'GET /_resolve/cluster' with no index expression returns {} on a
          -- single-node cluster with no remotes; the (local) entry only
          -- appears once an index expression is supplied.
          result <- tryEsError $ ClientES9.resolveCluster (Just ["bloodhound-tests-*"])
          liftIO $
            case result of
              Left e
                | endpointMissing e ->
                    pendingWith "resolve cluster requires Elasticsearch 9+"
              _ -> pure ()
          case result of
            Left e -> liftIO $ expectationFailure $ "resolveCluster failed: " <> show e
            Right resp ->
              liftIO $
                M.member "(local)" (ES9.resolveClusterResponseEntries resp)
                  `shouldBe` True

-- | 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)