bloodhound-1.0.0.0: tests/Test/ClusterRemoteInfoSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.ClusterRemoteInfoSpec where
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as AKM
import Data.HashMap.Strict qualified as HM
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Common
import TestsUtils.Import
spec :: Spec
spec = do
-- ---------------------------------------------------------------- --
-- RemoteClusterInfo JSON: pure, no ES required. --
-- Locks in the typed fields and the *Other catch-all that lets the --
-- decoder tolerate future ES additions without failing. --
-- ---------------------------------------------------------------- --
describe "RemoteClusterInfo JSON" $ do
let minimalBytes =
Aeson.object
[ "seeds" .= ([] :: [Text]),
"connected" .= False,
"num_nodes_connected" .= (0 :: Int),
"max_connections_per_cluster" .= (0 :: Int)
]
it "decodes the minimal ES response shape (no optional fields)" $ do
let decoded = Aeson.decode' (Aeson.encode minimalBytes) :: Maybe RemoteClusterInfo
decoded
`shouldBe` Just
( RemoteClusterInfo
{ remoteClusterInfoSeeds = [],
remoteClusterInfoConnected = False,
remoteClusterInfoNumNodesConnected = 0,
remoteClusterInfoMaxConnectionsPerCluster = 0,
remoteClusterInfoMode = Nothing,
remoteClusterInfoSkipUnavailable = Nothing,
-- The *Other field captures whatever was on the
-- wire (here: exactly the four typed fields).
remoteClusterInfoOther =
Aeson.object
[ "seeds" .= ([] :: [Text]),
"connected" .= False,
"num_nodes_connected" .= (0 :: Int),
"max_connections_per_cluster" .= (0 :: Int)
]
}
)
it "decodes the documented full fixture (sniff mode)" $ do
let bytes =
Aeson.object
[ "seeds" .= ["127.0.0.1:9400" :: Text],
"connected" .= True,
"num_nodes_connected" .= (3 :: Int),
"max_connections_per_cluster" .= (3 :: Int),
"initial_connect_timeout" .= ("30s" :: Text),
"skip_unavailable" .= False,
"mode" .= ("sniff" :: Text),
"proxy_address" .= Null,
"server_name" .= Null,
"has_proxy" .= False
]
decoded = Aeson.decode' (Aeson.encode bytes) :: Maybe RemoteClusterInfo
decoded
`shouldSatisfy` \case
Just rci ->
remoteClusterInfoConnected rci
&& remoteClusterInfoNumNodesConnected rci == 3
&& remoteClusterInfoMaxConnectionsPerCluster rci == 3
&& remoteClusterInfoMode rci == Just RemoteClusterModeSniff
&& remoteClusterInfoSkipUnavailable rci == Just False
&& remoteClusterInfoSeeds rci == ["127.0.0.1:9400"]
_ -> False
it "decodes the documented proxy-mode fixture" $ do
let bytes =
Aeson.object
[ "connected" .= True,
"num_nodes_connected" .= (1 :: Int),
"max_connections_per_cluster" .= (3 :: Int),
"mode" .= ("proxy" :: Text),
"proxy_address" .= ("my.proxy:443" :: Text),
"server_name" .= ("es.example.com" :: Text),
"skip_unavailable" .= True
]
decoded = Aeson.decode' (Aeson.encode bytes) :: Maybe RemoteClusterInfo
remoteClusterInfoMode <$> decoded `shouldBe` Just (Just RemoteClusterModeProxy)
it "round-trips a fully-populated RemoteClusterInfo" $ do
let rci =
RemoteClusterInfo
{ remoteClusterInfoSeeds = ["host:9300"],
remoteClusterInfoConnected = True,
remoteClusterInfoNumNodesConnected = 2,
remoteClusterInfoMaxConnectionsPerCluster = 3,
remoteClusterInfoMode = Just RemoteClusterModeSniff,
remoteClusterInfoSkipUnavailable = Just False,
remoteClusterInfoOther = Aeson.object []
}
encoded = Aeson.encode rci
decoded = Aeson.decode' encoded :: Maybe RemoteClusterInfo
-- Equality ignores *Other, so we round-trip via the typed
-- fields. The catch-all preserves whatever wire keys survived
-- the typed extraction.
decoded `shouldSatisfy` isJust
let Just rci' = decoded
remoteClusterInfoSeeds rci' `shouldBe` remoteClusterInfoSeeds rci
remoteClusterInfoConnected rci' `shouldBe` remoteClusterInfoConnected rci
remoteClusterInfoNumNodesConnected rci' `shouldBe` remoteClusterInfoNumNodesConnected rci
remoteClusterInfoMaxConnectionsPerCluster rci'
`shouldBe` remoteClusterInfoMaxConnectionsPerCluster rci
remoteClusterInfoMode rci' `shouldBe` remoteClusterInfoMode rci
remoteClusterInfoSkipUnavailable rci' `shouldBe` remoteClusterInfoSkipUnavailable rci
it "preserves unknown keys in the *Other field" $ do
let bytes =
Aeson.object
[ "connected" .= True,
"future_field" .= ("unknown value" :: Text),
"another_unknown" .= (42 :: Int)
]
decoded = Aeson.decode' (Aeson.encode bytes) :: Maybe RemoteClusterInfo
decoded `shouldSatisfy` isJust
let Just rci = decoded
case remoteClusterInfoOther rci of
Aeson.Object o -> do
-- Unknown keys survive.
AKM.lookup "future_field" o `shouldBe` Just (Aeson.String "unknown value")
AKM.lookup "another_unknown" o `shouldBe` Just (Aeson.Number 42)
-- Typed keys also remain in the *Other capture (per the
-- pendingTask precedent: 'pure (Object o)' on the original
-- object). Pinned here so a future refactor that switches
-- to a delete-filtered *Other is caught.
AKM.lookup "connected" o `shouldBe` Just (Aeson.Bool True)
_ -> expectationFailure "Expected *Other to be an Object"
it "RemoteClusterMode rejects unknown values" $ do
Aeson.decode' "\"rrf\"" `shouldBe` (Nothing :: Maybe RemoteClusterMode)
it "RemoteClusterMode round-trips sniff and proxy" $ do
Aeson.decode' (Aeson.encode RemoteClusterModeSniff) `shouldBe` Just RemoteClusterModeSniff
Aeson.decode' (Aeson.encode RemoteClusterModeProxy) `shouldBe` Just RemoteClusterModeProxy
-- ---------------------------------------------------------------- --
-- RemoteClustersInfo JSON: pure, no ES required. --
-- The wire shape is an object keyed by remote-cluster alias; the --
-- empty case (@{}@) decodes to mempty. --
-- ---------------------------------------------------------------- --
describe "RemoteClustersInfo JSON" $ do
it "decodes the empty response (no remotes configured)" $ do
let decoded = Aeson.decode' "{}" :: Maybe RemoteClustersInfo
decoded `shouldBe` Just (RemoteClustersInfo HM.empty)
it "decodes a multi-alias response" $ do
let bytes =
Aeson.object
[ "cluster_a"
.= Aeson.object
[ "connected" .= True,
"num_nodes_connected" .= (1 :: Int),
"mode" .= ("sniff" :: Text)
],
"cluster_b"
.= Aeson.object
[ "connected" .= False,
"num_nodes_connected" .= (0 :: Int)
]
]
decoded = Aeson.decode' (Aeson.encode bytes) :: Maybe RemoteClustersInfo
decoded `shouldSatisfy` isJust
let Just (RemoteClustersInfo m) = decoded
HM.size m `shouldBe` 2
HM.lookup "cluster_a" m `shouldSatisfy` (\(Just rci) -> remoteClusterInfoConnected rci)
HM.lookup "cluster_b" m `shouldSatisfy` (\(Just rci) -> not (remoteClusterInfoConnected rci))
it "round-trips an empty RemoteClustersInfo back to {}" $ do
let encoded = Aeson.encode (RemoteClustersInfo HM.empty)
Aeson.decode' encoded `shouldBe` Just (Aeson.object [])
it "round-trips a populated RemoteClustersInfo (alias-keyed)" $ do
let rci =
RemoteClusterInfo
{ remoteClusterInfoSeeds = ["host:9300"],
remoteClusterInfoConnected = True,
remoteClusterInfoNumNodesConnected = 1,
remoteClusterInfoMaxConnectionsPerCluster = 3,
remoteClusterInfoMode = Just RemoteClusterModeSniff,
remoteClusterInfoSkipUnavailable = Just False,
remoteClusterInfoOther = Aeson.object []
}
input = RemoteClustersInfo (HM.singleton "rc_a" rci)
encoded = Aeson.encode input
decoded = Aeson.decode' encoded :: Maybe RemoteClustersInfo
decoded `shouldSatisfy` isJust
let Just (RemoteClustersInfo m) = decoded
HM.size m `shouldBe` 1
-- The alias survives the KeyMap <-> HashMap round-trip
-- (exercises KM.toHashMapText / fromHashMapText symmetry).
HM.lookup "rc_a" m `shouldSatisfy` isJust
let Just rci' = HM.lookup "rc_a" m
remoteClusterInfoConnected rci' `shouldBe` True
remoteClusterInfoNumNodesConnected rci' `shouldBe` 1
-- ---------------------------------------------------------------- --
-- getRemoteClusterInfo endpoint shape: pure checks against the --
-- BHRequest value; no live backend needed. Mirrors the --
-- updateClusterSettings shape tests in Test.ClusterSettingsSpec. --
-- ---------------------------------------------------------------- --
describe "getRemoteClusterInfo endpoint shape" $ do
it "GETs /_remote/info with no queries and no body" $ do
let req = Common.getRemoteClusterInfo
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_remote", "info"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Nothing
-- ---------------------------------------------------------------- --
-- Live integration: gated via 'backendSpecific' so it runs only --
-- against the Elasticsearch backends that expose @/_remote/info@ --
-- (OpenSearch has no such endpoint — it 404s). Auto-skips (pending) --
-- when no server is reachable, keeping the local @cabal test@ gate --
-- green. On a fresh cluster with no remote clusters configured the --
-- server returns @{}@, which decodes to 'RemoteClustersInfo' --
-- 'HM.empty'. The path @/_remote/info@ is the documented URL on --
-- every supported ES version (7.x / 8.x / 9.x). --
-- ---------------------------------------------------------------- --
describe "getRemoteClusterInfo live" $
backendSpecific [ElasticSearch7, ElasticSearch8, ElasticSearch9] $
it "returns an empty map on a fresh cluster" $
withTestEnv $ do
info <- performBHRequest Common.getRemoteClusterInfo
liftIO $ info `shouldBe` RemoteClustersInfo HM.empty