ScriptLanguagesSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.ScriptLanguagesSpec (spec) where

import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.Common.Types
import TestsUtils.Common
import TestsUtils.Import

spec :: Spec
spec = do
  -- ------------------------------------------------------------------ --
  -- Pure JSON decoder tests (no ES required).                          --
  -- ------------------------------------------------------------------ --
  describe "ScriptLanguagesResponse JSON parsing" $ do
    let emptyBody = "{\"types_allowed\":[],\"language_contexts\":[]}"
        -- Captured from a live ES 7.17.25 cluster (trimmed to the
        -- expression + mustache languages; painless carries a long
        -- contexts list omitted here for brevity).
        fullBody =
          "{\"types_allowed\":[\"inline\",\"stored\"],\
          \\"language_contexts\":[\
          \{\"language\":\"expression\",\"contexts\":[\"aggs\",\"field\",\"filter\"]},\
          \{\"language\":\"mustache\",\"contexts\":[\"template\"]}\
          \]}"

    it "parses the empty response" $ do
      let Just (r :: ScriptLanguagesResponse) = decode emptyBody
      slrTypesAllowed r `shouldBe` []
      slrLanguageContexts r `shouldBe` []

    it "parses types_allowed and language_contexts" $ do
      let Just (r :: ScriptLanguagesResponse) = decode fullBody
      slrTypesAllowed r `shouldBe` ["inline", "stored"]
      length (slrLanguageContexts r) `shouldBe` 2
      let firstCtx = head (slrLanguageContexts r)
      slcLanguage firstCtx `shouldBe` ScriptLanguage "expression"
      slcContexts firstCtx `shouldContain` ["aggs", "field", "filter"]

    it "treats missing arrays as the empty list" $ do
      let Just (r :: ScriptLanguagesResponse) = decode "{}"
      slrTypesAllowed r `shouldBe` []
      slrLanguageContexts r `shouldBe` []

    it "round-trips the full response via ToJSON/FromJSON" $ do
      let Just (original :: ScriptLanguagesResponse) = decode fullBody
          reDecoded = decode (encode original) :: Maybe ScriptLanguagesResponse
      Just original `shouldBe` reDecoded

  describe "ScriptLanguageContext JSON parsing" $ do
    let body =
          "{\"language\":\"painless\",\"contexts\":[\"aggs\",\"score\",\"update\"]}"

    it "parses language and contexts" $ do
      let Just (c :: ScriptLanguageContext) = decode body
      slcLanguage c `shouldBe` ScriptLanguage "painless"
      slcContexts c `shouldBe` ["aggs", "score", "update"]

    it "uses parseJSON directly (covers the withObject path)" $
      case parseEither parseJSON (object ["language" .= String "expression"]) ::
             Either String ScriptLanguageContext of
        Right c -> slcLanguage c `shouldBe` ScriptLanguage "expression"
        Left err -> expectationFailure ("parseJSON failed: " <> err)

  -- ------------------------------------------------------------------ --
  -- Endpoint shape: pure checks against the BHRequest value; no live   --
  -- backend needed.                                                     --
  -- ------------------------------------------------------------------ --
  describe "getScriptLanguages endpoint shape" $ do
    it "GETs /_script_language with no body and no params" $ do
      let req = getScriptLanguages
      bhRequestMethod req `shouldBe` "GET"
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_script_language"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldBe` Nothing

  -- ------------------------------------------------------------------ --
  -- Live backend tests (need ES on ES_TEST_SERVER, default 9200).      --
  -- _script_language is served by ES 7.x/8.x/9.x and OpenSearch        --
  -- 2.x/3.x, but returns HTTP 500 on OpenSearch 1.3 (a server bug:     --
  -- null_pointer_exception in the response body). The block is gated   --
  -- by 'backendSpecific' so the OS 1.3 matrix job marks it pending     --
  -- instead of red.                                                    --
  -- ------------------------------------------------------------------ --
  describe "getScriptLanguages live API"
    $ backendSpecific
      [ ElasticSearch7,
        ElasticSearch8,
        ElasticSearch9,
        OpenSearch2,
        OpenSearch3
      ]
    $ do
      it "returns inline/stored as allowed types and a painless entry" $
        withTestEnv $ do
          r <- performBHRequest getScriptLanguages
          liftIO $ do
            slrTypesAllowed r `shouldContain` ["inline", "stored"]
            map slcLanguage (slrLanguageContexts r)
              `shouldContain` [ScriptLanguage "painless"]