packages feed

bloodhound-1.0.0.0: tests/Test/ExplainSpec.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Tests for the @POST \/{index}\/_explain\/{id}@ endpoint.
--
-- The first section is unit tests of the JSON instances for
-- 'Explanation' and 'ExplainResponse' (no live backend required).
-- The second section is live integration coverage under 'withTestEnv'
-- and only meaningful when an Elasticsearch\/OpenSearch backend is
-- reachable on 'ES_TEST_SERVER' (default @http://localhost:9200@).
module Test.ExplainSpec (spec) where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as LBS
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Common
import TestsUtils.Import

-- | Fixture mimicking the canonical matched-document example from the
-- ES docs at
-- https://www.elastic.co/guide/en/elasticsearch/reference/current/search-explain.html.
-- Two-level nesting is enough to exercise 'explanationDetails' parsing
-- without being brittle to server-specific scoring descriptions.
sampleMatchedExplainResponse :: LBS.ByteString
sampleMatchedExplainResponse =
  "{\
  \  \"_index\": \"my-index-000001\",\
  \  \"_id\": \"0\",\
  \  \"matched\": true,\
  \  \"explanation\": {\
  \    \"value\": 1.0,\
  \    \"description\": \"weight(name:foo in 0) [PerFieldSimilarity], result of:\",\
  \    \"details\": [\
  \      {\
  \        \"value\": 1.0,\
  \        \"description\": \"score(freq=1.0), computed as score from:\",\
  \        \"details\": [\
  \          {\
  \            \"value\": 1.4,\
  \            \"description\": \"idf, computed as log(1 + (N - n + 0.5) / (n + 0.5))\",\
  \            \"details\": []\
  \          }\
  \        ]\
  \      }\
  \    ]\
  \  }\
  \}"

-- | A minimal matched response with no nested details.
sampleLeafExplainResponse :: LBS.ByteString
sampleLeafExplainResponse =
  "{\
  \  \"_index\": \"ix\",\
  \  \"_id\": \"1\",\
  \  \"matched\": true,\
  \  \"explanation\": {\
  \    \"value\": 0.5,\
  \    \"description\": \"sum of:\",\
  \    \"details\": []\
  \  }\
  \}"

-- | Response for a document that did not match the query. The server
-- omits the @explanation@ field entirely when @matched@ is @false@;
-- only 'explainResponseMatched' distinguishes the non-match case.
sampleNonMatchedExplainResponse :: LBS.ByteString
sampleNonMatchedExplainResponse =
  "{\
  \  \"_index\": \"ix\",\
  \  \"_id\": \"1\",\
  \  \"matched\": false\
  \}"

spec :: Spec
spec = do
  describe "Explanation JSON" $ do
    it "decodes the canonical matched-response example, preserving two levels of detail" $ do
      let Just (decoded :: ExplainResponse) = decode sampleMatchedExplainResponse
      explainResponseMatched decoded `shouldBe` True
      unIndexName (explainResponseIndex decoded) `shouldBe` "my-index-000001"
      case explainResponseExplanation decoded of
        Nothing ->
          expectationFailure "expected a populated explanation on a matched response"
        Just explanation -> do
          explanationValue explanation `shouldBe` 1.0
          case explanationDetails explanation of
            [inner] -> do
              explanationValue inner `shouldBe` 1.0
              case explanationDetails inner of
                [leaf] -> do
                  explanationValue leaf `shouldBe` 1.4
                  explanationDetails leaf `shouldBe` []
                other ->
                  expectationFailure $ "expected a single leaf detail, got " <> show other
            other ->
              expectationFailure $ "expected a single inner detail, got " <> show other

    it "decodes an explanation with no details as an empty list" $ do
      let Just (decoded :: ExplainResponse) = decode sampleLeafExplainResponse
      let Just explanation = explainResponseExplanation decoded
      explanationValue explanation `shouldBe` 0.5
      explanationDetails explanation `shouldBe` []

    it "treats a missing 'details' field the same as an empty list" $ do
      let Just (decoded :: Explanation) =
            decode
              "{ \"value\": 0.0\
              \, \"description\": \"leaf without details key\" }"
      explanationDetails decoded `shouldBe` []

    it "round-trips a nested Explanation through ToJSON/FromJSON" $ do
      let original =
            Explanation
              { explanationValue = 2.0,
                explanationDescription = "sum of:",
                explanationDetails =
                  [ Explanation 1.0 "child A" [],
                    Explanation 1.0 "child B" [Explanation 0.5 "grandchild" []]
                  ]
              }
      (decode . encode) original `shouldBe` Just original

    it "tolerates unknown extra fields in the body" $ do
      let Just (decoded :: Explanation) =
            decode
              "{ \"value\": 0.0\
              \, \"description\": \"ok\"\
              \, \"future_field\": \"whatever\" }"
      explanationDescription decoded `shouldBe` "ok"

    it "rejects an explanation missing the required 'value' field" $ do
      let decoded =
            decode
              "{ \"description\": \"no value\" }" ::
              Maybe Explanation
      decoded `shouldBe` Nothing

    it "rejects an explanation missing the required 'description' field" $ do
      let decoded =
            decode
              "{ \"value\": 0.0 }" ::
              Maybe Explanation
      decoded `shouldBe` Nothing

  describe "ExplainResponse JSON" $ do
    it "decodes a matched response with a populated explanation" $ do
      let Just (decoded :: ExplainResponse) = decode sampleMatchedExplainResponse
      explainResponseMatched decoded `shouldBe` True
      unIndexName (explainResponseIndex decoded) `shouldBe` "my-index-000001"
      let DocId docIdValue = explainResponseId decoded
      docIdValue `shouldBe` "0"
      explainResponseExplanation decoded `shouldSatisfy` isJust

    it "decodes a non-matched response, preserving the matched=false flag and omitting the explanation" $ do
      let Just (decoded :: ExplainResponse) = decode sampleNonMatchedExplainResponse
      explainResponseMatched decoded `shouldBe` False
      explainResponseExplanation decoded `shouldBe` Nothing

    it "tolerates an explicit \"explanation\": null on a matched response" $ do
      let Just (decoded :: ExplainResponse) =
            decode
              "{ \"_index\": \"ix\"\
              \, \"_id\": \"1\"\
              \, \"matched\": true\
              \, \"explanation\": null }"
      explainResponseMatched decoded `shouldBe` True
      explainResponseExplanation decoded `shouldBe` Nothing

    it "rejects a body missing the required 'matched' field" $ do
      let decoded =
            decode
              "{ \"_index\": \"ix\"\
              \, \"_id\": \"1\"\
              \, \"explanation\": {\"value\": 0.0, \"description\": \"x\", \"details\": []} }" ::
              Maybe ExplainResponse
      decoded `shouldBe` Nothing

  describe "explainDocument request envelope" $ do
    -- Pinning the wire shape independently of the live backend. The
    -- path mirrors 'getDocument' (@\/{index}\/_doc\/{id}@) with the
    -- @_doc@ segment replaced by @_explain@.
    let query = TermQuery (Term "user" "bitemyapp") Nothing
        req = Common.explainDocument testIndex (DocId "42") query

    it "targets /{index}/_explain/{id} with no query parameters" $ do
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` [ unIndexName testIndex,
                     "_explain",
                     "42"
                   ]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "uses POST and carries the encoded query body" $ do
      bhRequestBody req `shouldSatisfy` isJust
      bhRequestMethod req `shouldBe` "POST"

    it "wraps the Query as {\"query\": ...} on the wire" $ do
      -- Pin the exact wire shape so a future refactor that drops
      -- the ExplainQuery wrapper (or changes the Query ToJSON) is
      -- caught here rather than silently breaking the request body.
      let q = TermQuery (Term "user" "bitemyapp") Nothing
      encode (ExplainQuery q)
        `shouldBe` "{\"query\":{\"term\":{\"user\":{\"value\":\"bitemyapp\"}}}}"

    it "explainDocumentWith threads ExplainOptions onto the endpoint query string" $ do
      let opts =
            defaultExplainOptions
              { eoRouting = Just "user-42",
                eoPreference = Just "_local"
              }
          withReq = Common.explainDocumentWith opts testIndex (DocId "42") query
      getRawEndpoint (bhRequestEndpoint withReq)
        `shouldBe` [ unIndexName testIndex,
                     "_explain",
                     "42"
                   ]
      -- The renderer preserves field-declaration order; routing is
      -- declared before preference in ExplainOptions.
      getRawEndpointQueries (bhRequestEndpoint withReq)
        `shouldBe` [ ("routing", Just "user-42"),
                     ("preference", Just "_local")
                   ]

  -- ----------------------------------------------------------------------
  -- Live integration: only meaningful when a backend is reachable.
  -- The bloodhound test suite as a whole requires ES/OS on
  -- ES_TEST_SERVER (see AGENTS.md); these tests follow the same
  -- convention as Test.DocumentsSpec.
  describe "explainDocument (integration)" $ do
    it "returns matched=True for a query that matches the indexed tweet" $
      withTestEnv $ do
        _ <- insertData
        result <-
          tryPerformBHRequest $
            Common.explainDocument
              testIndex
              (DocId "1")
              (TermQuery (Term "user" "bitemyapp") Nothing)
        case result of
          Left e ->
            liftIO $
              expectationFailure $
                "expected a successful explain, got EsError: " <> show e
          Right resp ->
            liftIO $ do
              explainResponseMatched resp `shouldBe` True
              explainResponseExplanation resp `shouldSatisfy` isJust

    it "returns matched=False for a query that does not match (doc still exists)" $
      withTestEnv $ do
        _ <- insertData
        result <-
          tryPerformBHRequest $
            Common.explainDocument
              testIndex
              (DocId "1")
              (TermQuery (Term "user" "nobody-would-pick-this-name") Nothing)
        case result of
          Left e ->
            liftIO $
              expectationFailure $
                "expected a successful explain, got EsError: " <> show e
          Right resp ->
            liftIO $ do
              explainResponseMatched resp `shouldBe` False
              -- Server still returns a synthetic explanation when the
              -- doc exists but doesn't match (typically value 0.0
              -- with a description like "no matching term").
              explainResponseExplanation resp `shouldSatisfy` isJust

    it "decodes a missing document (HTTP 404 body) as matched=False with no explanation" $
      withTestEnv $ do
        _ <- insertData
        result <-
          tryPerformBHRequest $
            Common.explainDocument
              testIndex
              (DocId "does-not-exist")
              (MatchAllQuery Nothing)
        case result of
          Left e ->
            liftIO $
              expectationFailure $
                "expected a successful explain for the 404 body, got EsError: " <> show e
          Right resp ->
            liftIO $ do
              explainResponseMatched resp `shouldBe` False
              -- The missing-doc body is
              -- {"_index":...,"_id":...,"matched":false} with NO
              -- explanation field; the 'Maybe' type lets the caller
              -- distinguish "missing doc" from "doc exists, no match".
              explainResponseExplanation resp `shouldBe` Nothing

    it "explainDocumentWith accepts URI parameters (preference) without error" $
      withTestEnv $ do
        _ <- insertData
        result <-
          tryPerformBHRequest $
            Common.explainDocumentWith
              defaultExplainOptions {eoPreference = Just "_local"}
              testIndex
              (DocId "1")
              (TermQuery (Term "user" "bitemyapp") Nothing)
        case result of
          Left e ->
            liftIO $
              expectationFailure $
                "expected a successful explain, got EsError: " <> show e
          Right resp ->
            liftIO $ do
              explainResponseMatched resp `shouldBe` True
              explainResponseExplanation resp `shouldSatisfy` isJust