SynonymsSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.SynonymsSpec (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.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 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 "Synonyms API (PUT/GET/DELETE /_synonyms/{synonyms_set_id})" $ do
  describe "SynonymsSetId JSON" $ do
    it "round-trips a SynonymsSetId" $ do
      let sid = Types.SynonymsSetId "my-synonyms-set"
      decode (encode sid) `shouldBe` Just sid

    it "unSynonymsSetId extracts the underlying Text" $
      Types.unSynonymsSetId (Types.SynonymsSetId "abc") `shouldBe` ("abc" :: Text)

  describe "SynonymRule JSON wire shape" $ do
    it "encodes a rule with an id as {id, synonyms}" $ do
      let rule = Types.SynonymRule (Just "test-1") "hello, hi"
      encode rule
        `shouldBe` "{\"id\":\"test-1\",\"synonyms\":\"hello, hi\"}"
      decode (encode rule) `shouldBe` Just rule

    it "omits id when Nothing (server mints one)" $ do
      let rule = Types.SynonymRule Nothing "bye, goodbye"
      hasKey "id" (encode rule) `shouldBe` False
      encode rule `shouldBe` "{\"synonyms\":\"bye, goodbye\"}"
      decode (encode rule) `shouldBe` Just rule

    it "decodes a rule that omits id" $ do
      let raw = LBS.pack "{\"synonyms\":\"universe, cosmos\"}"
      decode raw `shouldBe` Just (Types.SynonymRule Nothing "universe, cosmos")

    it "decodes a full GET-style rule with id" $ do
      let raw = LBS.pack "{\"id\":\"test-2\",\"synonyms\":\"test => check\"}"
      decode raw `shouldBe` Just (Types.SynonymRule (Just "test-2") "test => check")

  describe "SynonymsSet (PUT body) JSON" $ do
    it "encodes as {synonyms_set: [...]}" $ do
      let body =
            Types.SynonymsSet
              [ Types.SynonymRule (Just "test-1") "hello, hi",
                Types.SynonymRule Nothing "bye, goodbye"
              ]
      encode body
        `shouldBe` "{\"synonyms_set\":[{\"id\":\"test-1\",\"synonyms\":\"hello, hi\"},{\"synonyms\":\"bye, goodbye\"}]}"
      decode (encode body) `shouldBe` Just body

    it "encodes an empty set as {synonyms_set: []}" $
      encode (Types.SynonymsSet [])
        `shouldBe` "{\"synonyms_set\":[]}"

    it "decodes the documented PUT example verbatim" $ do
      let raw =
            LBS.pack
              "{\"synonyms_set\":[{\"id\":\"test-1\",\"synonyms\":\"hello, hi\"},{\"synonyms\":\"bye, goodbye\"},{\"id\":\"test-2\",\"synonyms\":\"test => check\"}]}"
      case decode raw :: Maybe Types.SynonymsSet of
        Just (Types.SynonymsSet rules) -> length rules `shouldBe` 3
        Nothing -> expectationFailure "failed to decode SynonymsSet"

  describe "SynonymsSetInfo (GET response) JSON" $ do
    it "decodes the documented GET response verbatim" $ do
      let raw =
            LBS.pack
              "{\"count\":3,\"synonyms_set\":[{\"id\":\"test-1\",\"synonyms\":\"hello, hi\"},{\"id\":\"test-2\",\"synonyms\":\"bye, goodbye\"},{\"id\":\"test-3\",\"synonyms\":\"test => check\"}]}"
      case decode raw :: Maybe Types.SynonymsSetInfo of
        Just info -> do
          Types.ssiCount info `shouldBe` 3
          length (Types.ssiRules info) `shouldBe` 3
        Nothing ->
          expectationFailure "failed to decode SynonymsSetInfo"

    it "defaults missing count/synonyms_set to 0/[]" $ do
      let raw = LBS.pack "{}"
      case decode raw :: Maybe Types.SynonymsSetInfo of
        Just info -> do
          Types.ssiCount info `shouldBe` 0
          Types.ssiRules info `shouldBe` []
        Nothing ->
          expectationFailure "failed to decode empty SynonymsSetInfo"

    it "round-trips a populated response" $ do
      let info =
            Types.SynonymsSetInfo
              { Types.ssiCount = 1,
                Types.ssiRules = [Types.SynonymRule (Just "a") "x, y"]
              }
      decode (encode info) `shouldBe` Just info

  describe "SynonymsSetPutResponse JSON" $ do
    it "decodes {acknowledged: true}" $ do
      let raw = LBS.pack "{\"acknowledged\":true}"
      decode raw `shouldBe` Just (Types.SynonymsSetPutResponse (Just True) Nothing)

    it "decodes {result: updated} (reload path)" $ do
      let raw = LBS.pack "{\"result\":\"updated\"}"
      decode raw `shouldBe` Just (Types.SynonymsSetPutResponse Nothing (Just "updated"))

    it "decodes both fields when present" $ do
      let raw = LBS.pack "{\"acknowledged\":true,\"result\":\"created\"}"
      decode raw `shouldBe` Just (Types.SynonymsSetPutResponse (Just True) (Just "created"))

  describe "synonymsGetOptionsParams URI rendering" $ do
    it "defaultSynonymsGetOptions emits no params" $
      Types.synonymsGetOptionsParams Types.defaultSynonymsGetOptions
        `shouldBe` []

    it "renders from and size" $ do
      let opts =
            Types.defaultSynonymsGetOptions
              { Types.sgoFrom = Just 5,
                Types.sgoSize = Just 20
              }
      Types.synonymsGetOptionsParams opts
        `shouldBe` [("from", Just "5"), ("size", Just "20")]

    it "renders only the set fields" $ do
      let opts =
            Types.defaultSynonymsGetOptions
              { Types.sgoSize = Just 50
              }
      Types.synonymsGetOptionsParams opts
        `shouldBe` [("size", Just "50")]

  describe "endpoint shape" $ do
    it "PUTs to /_synonyms/<id> with a body (ES8)" $ do
      let req =
            RequestsES8.putSynonymsSet
              "my-synonyms-set"
              (Types.SynonymsSet [Types.SynonymRule Nothing "a, b"])
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_synonyms", "my-synonyms-set"]
      bhRequestBody req `shouldSatisfy` isJust

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

    it "getSynonymsSetWith appends from/size query params" $ do
      let opts =
            Types.defaultSynonymsGetOptions
              { Types.sgoFrom = Just 1,
                Types.sgoSize = Just 2
              }
          req = RequestsES8.getSynonymsSetWith "my-synonyms-set" opts
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_synonyms", "my-synonyms-set"]
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("from", Just "1"), ("size", Just "2")]
      bhRequestBody req `shouldSatisfy` isNothing

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

  describe "live integration (requires ES8+ backend)" $
    backendSpecific [ElasticSearch8] $ do
      -- Search synonyms are available under the free basic license in
      -- ES 8.x, so the round-trip below should run on the docker-compose
      -- ES8 container. It still tolerates a privilege failure
      -- (manage_search_synonyms cluster privilege) by pending.
      it "round-trips a synonyms set via PUT then GET then DELETE" $
        withTestEnv $ do
          let sid = Types.SynonymsSetId "bloodhound-test-synonyms"
              body =
                Types.SynonymsSet
                  [ Types.SynonymRule (Just "test-1") "hello, hi",
                    Types.SynonymRule Nothing "bye, goodbye"
                  ]
          _ <-
            tryPerformBHRequest $
              RequestsES8.deleteSynonymsSet sid
          putResult <- tryEsError (ClientES8.putSynonymsSet sid body)
          case putResult of
            Left e
              | errorStatus e == Just 403
                  || "privilege" `T.isInfixOf` T.toLower (errorMessage e) ->
                  liftIO $
                    pendingWith
                      "synonyms API requires manage_search_synonyms \
                      \privilege; skip on locked-down clusters"
            Left e ->
              liftIO $
                expectationFailure $
                  "unexpected PUT error: " <> show e
            Right _putResp -> do
              info <- ClientES8.getSynonymsSet sid
              liftIO $ do
                Types.ssiCount info `shouldBe` 2
                length (Types.ssiRules info) `shouldBe` 2
              _ <- ClientES8.deleteSynonymsSet sid
              pure ()

      it "DELETE of a non-existent synonyms set surfaces a 4xx EsError" $
        withTestEnv $ do
          result <-
            tryPerformBHRequest $
              RequestsES8.deleteSynonymsSet
                (Types.SynonymsSetId "bloodhound-definitely-missing-synonyms")
          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 synonyms set to fail, but it succeeded"