HybridQuerySpec.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Pure-JSON tests for the OpenSearch @hybrid@ compound query clause.
--
-- These tests do not require a running OpenSearch instance (and do not
-- exercise the search-pipeline normalization/combination machinery, which
-- is configured out-of-band via @PUT /_search/pipeline/<id>@). They verify
-- that 'HybridQuery' (and the 'QueryHybridQuery' arm of 'Query')
-- serializes to the JSON shape documented at
-- <https://docs.opensearch.org/latest/query-dsl/compound/hybrid/>
-- and round-trips through 'ToJSON' \/ 'FromJSON'.
module Test.HybridQuerySpec (spec) where

import Data.Aeson
import Data.Aeson.Key (Key)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy qualified as LBS
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromJust)
import Data.Vector qualified as V
import Database.Bloodhound.Types
  ( FieldName (..),
    HybridQuery (..),
    Query (..),
    QueryString (..),
    Term (..),
    mkBoolQuery,
    mkHybridQuery,
    mkMatchQuery,
  )
import Test.Hspec (Spec, describe, it, shouldBe, shouldNotSatisfy, shouldSatisfy)

-- | A simple @match@ sub-query clause, used as filler inside hybrid
-- @queries@ arrays.
matchClause :: Query
matchClause =
  QueryMatchQuery
    (mkMatchQuery (FieldName "title") (QueryString "search engine"))

-- | A simple @term@ sub-query clause.
termClause :: Query
termClause =
  TermQuery (Term "category" "books") Nothing

-- | A @match_all@ clause for filler / filter use.
matchAll :: Query
matchAll = MatchAllQuery Nothing

-- | Walk into a nested dict path, returning the inner Value if reachable.
walk :: [Key] -> Value -> Maybe Value
walk [] v = Just v
walk (k : ks) (Object obj) = case KM.lookup k obj of
  Just v -> walk ks v
  Nothing -> Nothing
walk _ _ = Nothing

-- | True iff the encoded value is an Object containing the given key.
hasKey :: LBS.ByteString -> Key -> Bool
hasKey bs k = case decode bs of
  Just (Object obj) -> k `KM.member` obj
  _ -> False

-- | Unwrap the @hybrid@ body of an encoded HybridQuery \/ QueryHybridQuery.
hybridBody :: Value -> Maybe Value
hybridBody = walk ["hybrid"]

spec :: Spec
spec = describe "Hybrid query clause (OpenSearch)" $ do
  describe "HybridQuery body shape" $ do
    it "serializes as {\"hybrid\": {...}} at the top level" $ do
      let clause = mkHybridQuery (matchClause :| [])
      encode (QueryHybridQuery clause) `shouldSatisfy` \bs -> hasKey bs "hybrid"

    it "emits queries as an array under the hybrid key" $ do
      let clause = mkHybridQuery (matchClause :| [termClause])
      let Just (Object body) = hybridBody (fromJust (decode (encode (QueryHybridQuery clause))))
      case KM.lookup "queries" body of
        Just (Array arr) -> length arr `shouldBe` 2
        other -> fail $ "expected queries array, got " ++ show other

    it "serializes each sub-query through the parent Query ToJSON" $ do
      let clause = mkHybridQuery (matchClause :| [termClause])
      let Just (Object body) = hybridBody (fromJust (decode (encode (QueryHybridQuery clause))))
      case KM.lookup "queries" body of
        Just (Array arr) -> do
          case V.toList arr of
            (firstSub : _) -> decode (encode firstSub) `shouldBe` Just matchClause
            [] -> fail "queries array was unexpectedly empty"
        other -> fail $ "expected queries array, got " ++ show other

    it "omits the filter field when filter is Nothing" $ do
      let clause = mkHybridQuery (matchClause :| [])
      let Just (Object body) = hybridBody (fromJust (decode (encode (QueryHybridQuery clause))))
      body `shouldNotSatisfy` KM.member "filter"

    it "includes the filter field when filter is Just" $ do
      let clause =
            (mkHybridQuery (matchClause :| []))
              { hybridFilter = Just matchAll
              }
      let Just (Object body) = hybridBody (fromJust (decode (encode (QueryHybridQuery clause))))
      body `shouldSatisfy` KM.member "filter"

    it "emits a single-element queries array for a one-clause hybrid" $ do
      let clause = mkHybridQuery (matchClause :| [])
      let Just (Object body) = hybridBody (fromJust (decode (encode (QueryHybridQuery clause))))
      case KM.lookup "queries" body of
        Just (Array arr) -> length arr `shouldBe` 1
        other -> fail $ "expected queries array, got " ++ show other

  describe "HybridQuery round-trip" $ do
    it "round-trips a single-clause hybrid through ToJSON/FromJSON" $ do
      let clause = mkHybridQuery (matchClause :| [])
      decode (encode clause) `shouldBe` Just clause

    it "round-trips a two-clause hybrid through ToJSON/FromJSON" $ do
      let clause = mkHybridQuery (matchClause :| [termClause])
      decode (encode clause) `shouldBe` Just clause

    it "round-trips a hybrid with a filter set" $ do
      let clause =
            (mkHybridQuery (matchClause :| [termClause]))
              { hybridFilter = Just matchAll
              }
      decode (encode clause) `shouldBe` Just clause

    it "round-trips a hybrid whose sub-query is itself a compound (bool)" $ do
      let innerBool = QueryBoolQuery (mkBoolQuery [matchClause] [] [] [])
      let clause = mkHybridQuery (innerBool :| [])
      decode (encode clause) `shouldBe` Just clause

  describe "Query sum type integration" $ do
    it "QueryHybridQuery wraps the clause under the \"hybrid\" key" $ do
      let inner = mkHybridQuery (matchClause :| [])
      let wrapped = QueryHybridQuery inner
      encode wrapped `shouldSatisfy` \bs -> hasKey bs "hybrid"

    it "QueryHybridQuery round-trips through the parent Query sum type" $ do
      let inner = mkHybridQuery (matchClause :| [termClause])
      let wrapped = QueryHybridQuery inner
      decode (encode wrapped) `shouldBe` Just wrapped

    it "QueryHybridQuery round-trips with filter set" $ do
      let inner =
            (mkHybridQuery (matchClause :| []))
              { hybridFilter = Just matchAll
              }
      let wrapped = QueryHybridQuery inner
      decode (encode wrapped) `shouldBe` Just wrapped

    it "distinguishes hybrid from neural_sparse and neural in the parser" $ do
      let inner = mkHybridQuery (matchClause :| [])
      let wrapped = QueryHybridQuery inner
      let Just (Object obj) = decode (encode wrapped)
      obj `shouldNotSatisfy` KM.member "neural"
      obj `shouldNotSatisfy` KM.member "neural_sparse"
      obj `shouldSatisfy` KM.member "hybrid"

    it "parses hybrid clauses encountered as a bool sub-query" $ do
      let hybrid = QueryHybridQuery (mkHybridQuery (matchClause :| []))
      let boolQuery = QueryBoolQuery (mkBoolQuery [hybrid] [] [] [])
      decode (encode boolQuery) `shouldBe` Just boolQuery

  describe "HybridQuery parser rejects malformed clauses" $ do
    it "rejects hybrid clause with no queries field (via Query sum type)" $ do
      let bad = object ["hybrid" .= object ["filter" .= matchAll]]
      (decode (encode bad) :: Maybe Query) `shouldBe` Nothing

    it "rejects hybrid clause with an empty queries array (via Query sum type)" $ do
      let bad = object ["hybrid" .= object ["queries" .= ([] :: [Value])]]
      (decode (encode bad) :: Maybe Query) `shouldBe` Nothing

    it "rejects hybrid clause with queries that is not an array (via Query sum type)" $ do
      let bad = object ["hybrid" .= object ["queries" .= String "not an array"]]
      (decode (encode bad) :: Maybe Query) `shouldBe` Nothing

    it "rejects a direct HybridQuery body with an empty queries array" $ do
      -- Pins down the explicit fail at Query.hs FromJSON HybridQuery:
      -- "queries must be a non-empty array". Exercises the inner parser
      -- directly without going through the Query sum-type dispatch.
      let bad = object ["queries" .= ([] :: [Value])]
      (decode (encode bad) :: Maybe HybridQuery) `shouldBe` Nothing

    it "rejects a direct HybridQuery body with no queries field" $ do
      let bad = object ["filter" .= matchAll]
      (decode (encode bad) :: Maybe HybridQuery) `shouldBe` Nothing