packages feed

bloodhound-1.0.0.0: tests/Test/QueryRulesSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.QueryRulesSpec (spec) where

import Data.Aeson
import Data.Aeson.Key (Key)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Map.Strict qualified as Map
import Data.Maybe (isJust, isNothing)
import Data.Text qualified as T
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.ElasticSearch8.Client qualified as ClientES8
import Database.Bloodhound.ElasticSearch8.Requests qualified as RequestsES8
import Database.Bloodhound.ElasticSearch8.Types qualified as Types
import Database.Bloodhound.ElasticSearch9.Client qualified as ClientES9
import Database.Bloodhound.ElasticSearch9.Requests qualified as RequestsES9
import TestsUtils.Common
import TestsUtils.Import

hasKey :: Key -> LBS.ByteString -> Bool
hasKey k bs = case decode bs of
  Just (Object obj) -> k `KM.member` obj
  _ -> False

spec :: Spec
spec = describe "Query Rules API (PUT/GET/DELETE/TEST /_query_rules/{ruleset_id})" $ do
  describe "RulesetId / RuleId JSON" $ do
    it "round-trips a RulesetId" $ do
      let rid = Types.RulesetId "my-ruleset"
      decode (encode rid) `shouldBe` Just rid

    it "round-trips a RuleId" $ do
      let rid = Types.RuleId "my-rule"
      decode (encode rid) `shouldBe` Just rid

    it "unRulesetId extracts the underlying Text" $
      Types.unRulesetId (Types.RulesetId "abc") `shouldBe` ("abc" :: Text)

    it "unRuleId extracts the underlying Text" $
      Types.unRuleId (Types.RuleId "abc") `shouldBe` ("abc" :: Text)

  describe "RuleType JSON" $ do
    it "serializes PinnedRuleType as \"pinned\"" $ do
      encode Types.PinnedRuleType `shouldBe` "\"pinned\""
      Types.ruleTypeToText Types.PinnedRuleType `shouldBe` "pinned"

    it "serializes ExcludeRuleType as \"exclude\"" $ do
      encode Types.ExcludeRuleType `shouldBe` "\"exclude\""
      Types.ruleTypeToText Types.ExcludeRuleType `shouldBe` "exclude"

    it "round-trips PinnedRuleType" $
      decode (encode Types.PinnedRuleType) `shouldBe` Just Types.PinnedRuleType

    it "round-trips ExcludeRuleType" $
      decode (encode Types.ExcludeRuleType) `shouldBe` Just Types.ExcludeRuleType

    it "round-trips an unknown rule type via OtherRuleType" $ do
      let t = Types.OtherRuleType "rewind"
      decode (encode t) `shouldBe` Just t
      Types.ruleTypeFromText "rewind" `shouldBe` t

    it "parses \"pinned\" as PinnedRuleType (not OtherRuleType)" $
      Types.ruleTypeFromText "pinned" `shouldBe` Types.PinnedRuleType

    it "parses \"exclude\" as ExcludeRuleType (not OtherRuleType)" $
      Types.ruleTypeFromText "exclude" `shouldBe` Types.ExcludeRuleType

  describe "Criterion JSON wire shape" $ do
    it "encodes AlwaysCriterion with no metadata/values" $ do
      encode Types.AlwaysCriterion `shouldBe` "{\"type\":\"always\"}"
      decode (encode Types.AlwaysCriterion) `shouldBe` Just Types.AlwaysCriterion

    it "encodes GlobalCriterion with no metadata/values" $ do
      encode Types.GlobalCriterion `shouldBe` "{\"type\":\"global\"}"
      decode (encode Types.GlobalCriterion) `shouldBe` Just Types.GlobalCriterion

    it "parses \"global\" as GlobalCriterion (distinct from always)" $ do
      let raw = LBS.pack "{\"type\":\"global\"}"
      decode raw `shouldBe` Just Types.GlobalCriterion
      encode Types.GlobalCriterion `shouldNotBe` encode Types.AlwaysCriterion

    it "encodes ExactCriterion with metadata + values array" $ do
      let c = Types.ExactCriterion "user_country" (String "FR" :| [])
      encode c
        `shouldBe` "{\"metadata\":\"user_country\",\"type\":\"exact\",\"values\":[\"FR\"]}"
      decode (encode c) `shouldBe` Just c

    it "encodes FuzzyCriterion" $ do
      let c = Types.FuzzyCriterion "user_country" (String "FR" :| [String "DE"])
      encode c
        `shouldBe` "{\"metadata\":\"user_country\",\"type\":\"fuzzy\",\"values\":[\"FR\",\"DE\"]}"
      decode (encode c) `shouldBe` Just c

    it "encodes ContainsCriterion" $ do
      let c = Types.ContainsCriterion "tag" (String "shoes" :| [])
      encode c
        `shouldBe` "{\"metadata\":\"tag\",\"type\":\"contains\",\"values\":[\"shoes\"]}"
      decode (encode c) `shouldBe` Just c

    it "encodes PrefixCriterion" $ do
      let c = Types.PrefixCriterion "q" (String "star" :| [])
      encode c `shouldBe` "{\"metadata\":\"q\",\"type\":\"prefix\",\"values\":[\"star\"]}"
      decode (encode c) `shouldBe` Just c

    it "encodes SuffixCriterion" $ do
      let c = Types.SuffixCriterion "q" (String "wars" :| [])
      encode c `shouldBe` "{\"metadata\":\"q\",\"type\":\"suffix\",\"values\":[\"wars\"]}"
      decode (encode c) `shouldBe` Just c

    it "encodes GreaterThanCriterion" $ do
      let c = Types.GreaterThanCriterion "age" (Number 30)
      encode c `shouldBe` "{\"metadata\":\"age\",\"type\":\"gt\",\"values\":[30]}"
      decode (encode c) `shouldBe` Just c

    it "encodes GreaterThanEqualCriterion" $ do
      let c = Types.GreaterThanEqualCriterion "age" (Number 30)
      encode c `shouldBe` "{\"metadata\":\"age\",\"type\":\"gte\",\"values\":[30]}"
      decode (encode c) `shouldBe` Just c

    it "encodes LessThanCriterion" $ do
      let c = Types.LessThanCriterion "age" (Number 30)
      encode c `shouldBe` "{\"metadata\":\"age\",\"type\":\"lt\",\"values\":[30]}"
      decode (encode c) `shouldBe` Just c

    it "encodes LessThanEqualCriterion" $ do
      let c = Types.LessThanEqualCriterion "age" (Number 30)
      encode c `shouldBe` "{\"metadata\":\"age\",\"type\":\"lte\",\"values\":[30]}"
      decode (encode c) `shouldBe` Just c

    it "encodes GenericCriterion as raw JSON" $ do
      let raw =
            object
              [ "type" .= ("future_type" :: Text),
                "metadata" .= ("k" :: Text),
                "values" .= [Number 42]
              ]
          c = Types.GenericCriterion raw
      encode c `shouldBe` encode raw
      decode (encode c) `shouldBe` Just c

    it "decodes an unknown criterion type as GenericCriterion" $ do
      let raw =
            LBS.pack
              "{\"type\":\"future_type\",\"metadata\":\"k\",\"values\":[1]}"
      case decode raw :: Maybe Types.Criterion of
        Just (Types.GenericCriterion _) -> pure ()
        other -> expectationFailure $ "expected GenericCriterion, got: " <> show other

    it "rejects ExactCriterion with an empty values array" $ do
      let raw =
            LBS.pack
              "{\"type\":\"exact\",\"metadata\":\"k\",\"values\":[]}"
      (decode raw :: Maybe Types.Criterion) `shouldBe` Nothing

    it "rejects GreaterThanCriterion with multiple values" $ do
      let raw =
            LBS.pack
              "{\"type\":\"gt\",\"metadata\":\"k\",\"values\":[1,2]}"
      (decode raw :: Maybe Types.Criterion) `shouldBe` Nothing

  describe "PinnedDoc JSON" $ do
    it "round-trips a doc with _index and _id" $ do
      let d = Types.PinnedDoc (Just "my-index") "doc1"
      decode (encode d) `shouldBe` Just d

    it "round-trips a doc with bare _id (omits _index)" $ do
      let d = Types.PinnedDoc Nothing "doc1"
      let json = encode d
      json `shouldNotSatisfy` hasKey "_index"
      decode (encode d) `shouldBe` Just d

  describe "PinnedActions JSON" $ do
    it "omits docs/ids when not set" $ do
      let pa = Types.PinnedActions [] []
      encode pa `shouldBe` "{}"

    it "emits docs when set" $ do
      let pa = Types.PinnedActions [Types.PinnedDoc Nothing "a"] []
      let json = encode pa
      json `shouldSatisfy` hasKey "docs"
      json `shouldNotSatisfy` hasKey "ids"
      json `shouldNotSatisfy` hasKey "organic"

    it "emits ids when set" $ do
      let pa = Types.PinnedActions [] ["a", "b"]
      let json = encode pa
      json `shouldSatisfy` hasKey "ids"
      json `shouldNotSatisfy` hasKey "docs"

    it "never emits organic (field removed)" $ do
      let pa = Types.PinnedActions [Types.PinnedDoc (Just "idx") "a"] []
      encode pa `shouldNotSatisfy` hasKey "organic"

    it "decodes a missing docs/ids as empty lists" $ do
      let raw = LBS.pack "{}"
      case decode raw :: Maybe Types.PinnedActions of
        Just pa -> do
          Types.paDocs pa `shouldBe` []
          Types.paIds pa `shouldBe` []
        Nothing -> expectationFailure "failed to decode empty PinnedActions"

    it "tolerates a stray organic key from an old server response" $ do
      let raw = LBS.pack "{\"organic\":[{\"_id\":\"x\"}],\"ids\":[\"a\"]}"
      case decode raw :: Maybe Types.PinnedActions of
        Just pa -> Types.paIds pa `shouldBe` ["a"]
        Nothing ->
          expectationFailure "stray organic key should be ignored, not rejected"

  describe "Rule JSON" $ do
    it "round-trips a fully-populated pinned rule" $ do
      let rule =
            Types.Rule
              { Types.rRuleId = "r1",
                Types.rType = Types.PinnedRuleType,
                Types.rCriteria =
                  [ Types.AlwaysCriterion,
                    Types.ExactCriterion
                      "user_country"
                      (String "FR" :| [])
                  ],
                Types.rActions =
                  Types.PinnedActions
                    [Types.PinnedDoc (Just "movies") "tt0114709"]
                    [],
                Types.rPriority = Nothing
              }
      decode (encode rule) `shouldBe` Just rule

    it "round-trips an exclude rule with ids actions" $ do
      let rule =
            Types.Rule
              { Types.rRuleId = "r2",
                Types.rType = Types.ExcludeRuleType,
                Types.rCriteria =
                  [Types.GreaterThanCriterion "age" (Number 65)],
                Types.rActions = Types.PinnedActions [] ["1", "2"],
                Types.rPriority = Nothing
              }
      decode (encode rule) `shouldBe` Just rule

    it "encodes the rule_id, type, criteria, actions keys" $ do
      let rule =
            Types.Rule
              { Types.rRuleId = "r1",
                Types.rType = Types.PinnedRuleType,
                Types.rCriteria = [Types.AlwaysCriterion],
                Types.rActions =
                  Types.PinnedActions [Types.PinnedDoc Nothing "x"] [],
                Types.rPriority = Nothing
              }
      let json = encode rule
      json `shouldSatisfy` hasKey "rule_id"
      json `shouldSatisfy` hasKey "type"
      json `shouldSatisfy` hasKey "criteria"
      json `shouldSatisfy` hasKey "actions"

    it "omits priority when it is Nothing" $ do
      let rule =
            Types.Rule
              { Types.rRuleId = "r1",
                Types.rType = Types.PinnedRuleType,
                Types.rCriteria = [Types.AlwaysCriterion],
                Types.rActions = Types.PinnedActions [] ["1"],
                Types.rPriority = Nothing
              }
      encode rule `shouldNotSatisfy` hasKey "priority"

    it "emits priority as a number when set" $ do
      let rule =
            Types.Rule
              { Types.rRuleId = "r1",
                Types.rType = Types.PinnedRuleType,
                Types.rCriteria = [Types.GlobalCriterion],
                Types.rActions = Types.PinnedActions [] ["1"],
                Types.rPriority = Just 5
              }
      let json = encode rule
      json `shouldSatisfy` hasKey "priority"
      case decode json :: Maybe Types.Rule of
        Just r -> Types.rPriority r `shouldBe` Just 5
        Nothing -> expectationFailure "failed to round-trip rule with priority"

    it "decodes a rule without priority as Nothing (backward compatible)" $ do
      let raw =
            LBS.pack
              "{\"rule_id\":\"r1\",\"type\":\"pinned\",\"criteria\":[{\"type\":\"always\"}],\"actions\":{\"ids\":[\"1\"]}}"
      case decode raw :: Maybe Types.Rule of
        Just r -> Types.rPriority r `shouldBe` Nothing
        Nothing -> expectationFailure "failed to decode rule without priority"

  describe "QueryRuleset JSON" $ do
    it "round-trips an empty ruleset" $ do
      let rs = Types.QueryRuleset []
      let json = encode rs
      json `shouldBe` "{\"rules\":[]}"
      decode json `shouldBe` Just rs

    it "round-trips a populated ruleset" $ do
      let rs =
            Types.QueryRuleset
              [ Types.Rule
                  { Types.rRuleId = "r1",
                    Types.rType = Types.PinnedRuleType,
                    Types.rCriteria = [Types.AlwaysCriterion],
                    Types.rActions =
                      Types.PinnedActions
                        [Types.PinnedDoc (Just "i") "1"]
                        [],
                    Types.rPriority = Nothing
                  }
              ]
      decode (encode rs) `shouldBe` Just rs

  describe "QueryRulesetPutResponse JSON" $ do
    it "decodes a created response" $ do
      let raw = LBS.pack "{\"result\":\"created\"}"
      case decode raw :: Maybe Types.QueryRulesetPutResponse of
        Just resp -> Types.qrprResult resp `shouldBe` "created"
        Nothing -> expectationFailure "failed to decode created response"

    it "decodes an updated response" $ do
      let raw = LBS.pack "{\"result\":\"updated\"}"
      case decode raw :: Maybe Types.QueryRulesetPutResponse of
        Just resp -> Types.qrprResult resp `shouldBe` "updated"
        Nothing -> expectationFailure "failed to decode updated response"

    it "round-trips" $ do
      let resp = Types.QueryRulesetPutResponse "created"
      decode (encode resp) `shouldBe` Just resp

  describe "QueryRulesetInfo JSON" $ do
    it "round-trips a complete GET response" $ do
      let info =
            Types.QueryRulesetInfo
              { Types.qriId = "my-ruleset",
                Types.qriRules =
                  [ Types.Rule
                      { Types.rRuleId = "r1",
                        Types.rType = Types.PinnedRuleType,
                        Types.rCriteria = [Types.AlwaysCriterion],
                        Types.rActions =
                          Types.PinnedActions
                            [Types.PinnedDoc Nothing "1"]
                            [],
                        Types.rPriority = Nothing
                      }
                  ]
              }
      let json = encode info
      json `shouldSatisfy` hasKey "ruleset_id"
      json `shouldSatisfy` hasKey "rules"
      decode json `shouldBe` Just info

    it "decodes a realistic ES GET response body" $ do
      let raw =
            LBS.pack
              "{\"ruleset_id\":\"my-ruleset\",\"rules\":[{\"rule_id\":\"r1\",\"type\":\"pinned\",\"criteria\":[{\"type\":\"exact\",\"metadata\":\"user_country\",\"values\":[\"FR\"]}],\"actions\":{\"docs\":[{\"_index\":\"movies\",\"_id\":\"tt0114709\"}]}}]}"
      case decode raw :: Maybe Types.QueryRulesetInfo of
        Just info -> do
          Types.qriId info `shouldBe` "my-ruleset"
          case Types.qriRules info of
            [rule] -> do
              Types.unRuleId (Types.rRuleId rule) `shouldBe` "r1"
              Types.rType rule `shouldBe` Types.PinnedRuleType
              case Types.rCriteria rule of
                [Types.ExactCriterion md vals] -> do
                  md `shouldBe` "user_country"
                  vals `shouldBe` (String "FR" :| [])
                other ->
                  expectationFailure $ "expected ExactCriterion, got: " <> show other
              Types.paDocs (Types.rActions rule)
                `shouldBe` [Types.PinnedDoc (Just "movies") "tt0114709"]
            other ->
              expectationFailure $ "expected one rule, got: " <> show other
        Nothing ->
          expectationFailure "failed to decode QueryRulesetInfo"

  describe "QueryRulesetTest JSON" $ do
    it "round-trips a non-empty match_criteria map" $ do
      let body =
            Types.QueryRulesetTest
              { Types.qrtMatchCriteria =
                  Map.fromList
                    [ ("user_query", String "pugs"),
                      ("user_country", String "us")
                    ]
              }
      let json = encode body
      json `shouldSatisfy` hasKey "match_criteria"
      decode json `shouldBe` Just body

    it "decodes a realistic ES _test request body" $ do
      let raw =
            LBS.pack
              "{\"match_criteria\":{\"user_query\":\"pugs\",\"user_country\":\"us\"}}"
      case decode raw :: Maybe Types.QueryRulesetTest of
        Just body ->
          Map.lookup "user_query" (Types.qrtMatchCriteria body)
            `shouldBe` Just (String "pugs")
        Nothing ->
          expectationFailure "failed to decode QueryRulesetTest"

    it "round-trips an empty match_criteria map" $ do
      let body = Types.QueryRulesetTest Map.empty
      decode (encode body) `shouldBe` Just body

  describe "QueryRulesetTestMatchedRule JSON" $ do
    it "round-trips a matched-rule entry" $ do
      let mr =
            Types.QueryRulesetTestMatchedRule
              { Types.qrtmrRulesetId = "my-ruleset",
                Types.qrtmrRuleId = "my-rule1"
              }
      decode (encode mr) `shouldBe` Just mr

    it "decodes a realistic ES matched-rule entry" $ do
      let raw =
            LBS.pack
              "{\"ruleset_id\":\"my-ruleset\",\"rule_id\":\"my-rule1\"}"
      case decode raw :: Maybe Types.QueryRulesetTestMatchedRule of
        Just mr -> do
          Types.unRulesetId (Types.qrtmrRulesetId mr) `shouldBe` "my-ruleset"
          Types.unRuleId (Types.qrtmrRuleId mr) `shouldBe` "my-rule1"
        Nothing ->
          expectationFailure "failed to decode QueryRulesetTestMatchedRule"

  describe "QueryRulesetTestResponse JSON" $ do
    it "round-trips a complete response" $ do
      let resp =
            Types.QueryRulesetTestResponse
              { Types.qrtTotal = 1,
                Types.qrtMatched =
                  [ Types.QueryRulesetTestMatchedRule
                      { Types.qrtmrRulesetId = "my-ruleset",
                        Types.qrtmrRuleId = "my-rule1"
                      }
                  ]
              }
      let json = encode resp
      json `shouldSatisfy` hasKey "total_matched_rules"
      json `shouldSatisfy` hasKey "matched_rules"
      decode json `shouldBe` Just resp

    it "decodes a realistic ES _test response body" $ do
      let raw =
            LBS.pack
              "{\"total_matched_rules\":1,\"matched_rules\":[{\"ruleset_id\":\"my-ruleset\",\"rule_id\":\"my-rule1\"}]}"
      case decode raw :: Maybe Types.QueryRulesetTestResponse of
        Just resp -> do
          Types.qrtTotal resp `shouldBe` 1
          case Types.qrtMatched resp of
            [mr] ->
              Types.unRuleId (Types.qrtmrRuleId mr) `shouldBe` "my-rule1"
            other ->
              expectationFailure $ "expected one matched rule, got: " <> show other
        Nothing ->
          expectationFailure "failed to decode QueryRulesetTestResponse"

    it "decodes a response with zero matched rules" $ do
      let raw =
            LBS.pack
              "{\"total_matched_rules\":0,\"matched_rules\":[]}"
      case decode raw :: Maybe Types.QueryRulesetTestResponse of
        Just resp -> do
          Types.qrtTotal resp `shouldBe` 0
          Types.qrtMatched resp `shouldBe` []
        Nothing ->
          expectationFailure "failed to decode empty QueryRulesetTestResponse"

  describe "endpoint shape" $ do
    it "PUTs to /_query_rules/<id> with a body (ES8)" $ do
      let req =
            RequestsES8.putQueryRuleset
              "my-ruleset"
              (Types.QueryRuleset [])
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query_rules", "my-ruleset"]
      bhRequestBody req `shouldSatisfy` isJust

    it "GETs /_query_rules/<id> with no body (ES8)" $ do
      let req = RequestsES8.getQueryRuleset "my-ruleset"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query_rules", "my-ruleset"]
      bhRequestBody req `shouldSatisfy` isNothing

    it "DELETEs /_query_rules/<id> with no body (ES8)" $ do
      let req = RequestsES8.deleteQueryRuleset "my-ruleset"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query_rules", "my-ruleset"]
      bhRequestBody req `shouldSatisfy` isNothing

    it "POSTs to /_query_rules/<id>/_test with a body (ES8)" $ do
      let req =
            RequestsES8.testQueryRuleset
              "my-ruleset"
              (Types.QueryRulesetTest (Map.fromList [("user_query", String "pugs")]))
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query_rules", "my-ruleset", "_test"]
      bhRequestBody req `shouldSatisfy` isJust

    it "ES9 request builders hit the same paths as ES8" $ do
      let putReq =
            RequestsES9.putQueryRuleset
              "r"
              (Types.QueryRuleset [])
      let getReq = RequestsES9.getQueryRuleset "r"
      let delReq = RequestsES9.deleteQueryRuleset "r"
      let testReq =
            RequestsES9.testQueryRuleset
              "r"
              (Types.QueryRulesetTest Map.empty)
      getRawEndpoint (bhRequestEndpoint putReq) `shouldBe` ["_query_rules", "r"]
      getRawEndpoint (bhRequestEndpoint getReq) `shouldBe` ["_query_rules", "r"]
      getRawEndpoint (bhRequestEndpoint delReq) `shouldBe` ["_query_rules", "r"]
      getRawEndpoint (bhRequestEndpoint testReq) `shouldBe` ["_query_rules", "r", "_test"]
      bhRequestBody putReq `shouldSatisfy` isJust
      bhRequestBody getReq `shouldSatisfy` isNothing
      bhRequestBody delReq `shouldSatisfy` isNothing
      bhRequestBody testReq `shouldSatisfy` isJust

  describe "live integration (requires ES8+ backend)" $
    backendSpecific [ElasticSearch8, ElasticSearch9] $ do
      -- The positive PUT → GET → DELETE round-trip is gated in
      -- production Elasticsearch behind a trial/enterprise license
      -- (query rules are not available under the free basic license
      -- that the docker-compose ES8/ES9 containers ship with). The
      -- pure-JSON and endpoint-shape tests above exercise the
      -- implementation in detail; this live test exists as a
      -- manual smoke-test for clusters with an appropriate license.
      it "round-trips a ruleset via PUT then GET then DELETE" $
        withTestEnv $ do
          let ruleset =
                Types.QueryRuleset
                  [ Types.Rule
                      { Types.rRuleId = "bloodhound-test-rule",
                        Types.rType = Types.PinnedRuleType,
                        Types.rCriteria =
                          [ Types.ExactCriterion
                              "user_country"
                              (String "FR" :| [])
                          ],
                        Types.rActions =
                          Types.PinnedActions
                            [ Types.PinnedDoc
                                (Just "bloodhound-tests-twitter-1")
                                "1"
                            ]
                            [],
                        Types.rPriority = Nothing
                      }
                  ]
              rid = Types.RulesetId "bloodhound-test-query-rules"
          _ <-
            tryPerformBHRequest $
              RequestsES8.deleteQueryRuleset rid
          backend <- liftIO detectBackendType
          let putReq =
                if backend == Just ElasticSearch9
                  then ClientES9.putQueryRuleset rid ruleset
                  else ClientES8.putQueryRuleset rid ruleset
          putResult <- tryEsError putReq
          case putResult of
            Left e
              | errorStatus e == Just 403
                  || "license" `T.isInfixOf` T.toLower (errorMessage e) ->
                  liftIO $
                    pendingWith
                      "query rules require trial/enterprise license; \
                      \skip on basic-license clusters"
            Left e ->
              liftIO $
                expectationFailure $
                  "unexpected PUT error: " <> show e
            Right putResp -> do
              liftIO $
                Types.qrprResult putResp
                  `shouldSatisfy` (\r -> r == "created" || r == "updated")
              info <-
                if backend == Just ElasticSearch9
                  then ClientES9.getQueryRuleset rid
                  else ClientES8.getQueryRuleset rid
              liftIO $ length (Types.qriRules info) `shouldBe` 1
              -- _test: matching criteria should surface the rule.
              let matchBody =
                    Types.QueryRulesetTest
                      (Map.fromList [("user_country", String "FR")])
                  missBody =
                    Types.QueryRulesetTest
                      (Map.fromList [("user_country", String "US")])
                  runTest =
                    if backend == Just ElasticSearch9
                      then ClientES9.testQueryRuleset rid
                      else ClientES8.testQueryRuleset rid
              matchResp <- runTest matchBody
              liftIO $ do
                Types.qrtTotal matchResp `shouldBe` 1
                length (Types.qrtMatched matchResp) `shouldBe` 1
              missResp <- runTest missBody
              liftIO $ do
                Types.qrtTotal missResp `shouldBe` 0
                Types.qrtMatched missResp `shouldBe` []
              _ <-
                if backend == Just ElasticSearch9
                  then ClientES9.deleteQueryRuleset rid
                  else ClientES8.deleteQueryRuleset rid
              pure ()

      it "DELETE of a non-existent ruleset surfaces a 4xx EsError" $
        withTestEnv $ do
          result <-
            tryPerformBHRequest $
              RequestsES8.deleteQueryRuleset
                (Types.RulesetId "bloodhound-definitely-missing-ruleset")
          case result of
            Left e ->
              case errorStatus e of
                Just s -> liftIO $ (s >= 400 && s < 500) `shouldBe` True
                Nothing ->
                  liftIO $
                    expectationFailure $
                      "expected a 4xx status, got none. Message: "
                        <> show (errorMessage e)
            Right _ ->
              liftIO $
                expectationFailure
                  "expected DELETE of a missing ruleset to fail, but it succeeded"