bloodhound-1.0.0.0: tests/Test/SearchBodySpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.SearchBodySpec (spec) where
import Data.Aeson
( Value (..),
decode,
encode,
object,
toJSON,
(.=),
)
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types (Object)
import Data.HashMap.Strict (singleton)
import Data.List (sort)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Database.Bloodhound.Common.Requests (mkSearch)
import Database.Bloodhound.Common.Types
import Optics ((&), (?~), (^.))
import Test.Hspec (Spec, describe, it, shouldBe, shouldNotBe)
-- | Lookup helper: pull a single key's value from a rendered Search body.
-- Fails loudly (returns @Nothing@) if the rendered JSON isn't an object or
-- the key is absent.
lookupKey :: Text -> Value -> Maybe Value
lookupKey k (Object o) = KM.lookup (K.fromText k) o
lookupKey _ _ = Nothing
-- | Membership test, also handling non-object rendered output.
hasKey :: Text -> Value -> Bool
hasKey k (Object o) = KM.member (K.fromText k) o
hasKey _ _ = False
spec :: Spec
spec = do
specSearchBodyScalar
specRuntimeMappings
specRescore
specCollapse
specRetriever
specSearchBodyScalar :: Spec
specSearchBodyScalar = do
describe "TrackTotalHits JSON instances" $ do
it "TrackTotalHitsAll renders as Boolean true" $ do
toJSON TrackTotalHitsAll `shouldBe` Bool True
it "TrackTotalHitsOff renders as Boolean false" $ do
toJSON TrackTotalHitsOff `shouldBe` Bool False
it "TrackTotalHitsUpTo renders as a Number" $ do
toJSON (TrackTotalHitsUpTo 1000) `shouldBe` Number 1000
it "FromJSON round-trips every constructor" $ do
decode (encode TrackTotalHitsAll) `shouldBe` Just TrackTotalHitsAll
decode (encode TrackTotalHitsOff) `shouldBe` Just TrackTotalHitsOff
decode (encode (TrackTotalHitsUpTo 42)) `shouldBe` Just (TrackTotalHitsUpTo 42)
it "FromJSON accepts a raw numeric literal" $ do
decode "1234" `shouldBe` Just (TrackTotalHitsUpTo 1234)
describe "Search body JSON: default shape" $ do
it "mkSearch with Nothing/Nothing emits only from, size, track_scores" $ do
let value = toJSON (mkSearch Nothing Nothing :: Search)
case value of
Object o ->
sortKeys o
`shouldBe` sortKeys
( KM.fromList
[ (K.fromText "from", Number 0),
(K.fromText "size", Number 10),
(K.fromText "track_scores", Bool False)
]
)
_ -> error "expected object"
it "mkSearch retains a stable wire shape regardless of new fields" $ do
-- Pins the JSON bytes of the common case so future field additions
-- can't silently change what we send.
encode (mkSearch Nothing Nothing :: Search)
`shouldBe` "{\"from\":0,\"size\":10,\"track_scores\":false}"
describe "Search body JSON: each new scalar field renders under its wire key" $ do
let base = mkSearch Nothing Nothing :: Search
it "track_total_hits: true via TrackTotalHitsAll" $ do
lookupKey "track_total_hits" (toJSON base {trackTotalHits = Just TrackTotalHitsAll})
`shouldBe` Just (Bool True)
it "track_total_hits: false via TrackTotalHitsOff" $ do
lookupKey "track_total_hits" (toJSON base {trackTotalHits = Just TrackTotalHitsOff})
`shouldBe` Just (Bool False)
it "track_total_hits: N via TrackTotalHitsUpTo" $ do
lookupKey "track_total_hits" (toJSON base {trackTotalHits = Just (TrackTotalHitsUpTo 5000)})
`shouldBe` Just (Number 5000)
it "timeout renders verbatim" $ do
lookupKey "timeout" (toJSON base {timeout = Just "1s"})
`shouldBe` Just (String "1s")
it "min_score renders as Number" $ do
lookupKey "min_score" (toJSON base {minScore = Just 0.5})
`shouldBe` Just (Number 0.5)
it "explain renders as Boolean" $ do
lookupKey "explain" (toJSON base {explain = Just True})
`shouldBe` Just (Bool True)
it "version renders as Boolean (field named searchVersion)" $ do
lookupKey "version" (toJSON base {searchVersion = Just True})
`shouldBe` Just (Bool True)
it "seq_no_primary_term renders as Boolean" $ do
lookupKey "seq_no_primary_term" (toJSON base {seqNoPrimaryTerm = Just True})
`shouldBe` Just (Bool True)
it "terminate_after renders as Number" $ do
lookupKey "terminate_after" (toJSON base {terminateAfter = Just 100})
`shouldBe` Just (Number 100)
it "stats renders as a JSON array of strings" $ do
lookupKey "stats" (toJSON base {stats = Just ["my_search", "audit"]})
`shouldBe` Just (toJSON (["my_search", "audit"] :: [Text]))
it "search_pipeline renders verbatim" $ do
lookupKey "search_pipeline" (toJSON base {searchPipeline = Just "my_pipeline"})
`shouldBe` Just (String "my_pipeline")
it "stored_fields renders as a JSON array of strings" $ do
lookupKey "stored_fields" (toJSON base {storedFields = Just [FieldName "user", FieldName "message"]})
`shouldBe` Just (toJSON (["user", "message"] :: [Text]))
describe "Search body JSON: absence semantics" $ do
it "omits the wire key when the field is Nothing" $ do
let rendered = toJSON (mkSearch Nothing Nothing :: Search)
-- All ten new keys must be absent.
hasKey "track_total_hits" rendered `shouldBe` False
hasKey "timeout" rendered `shouldBe` False
hasKey "min_score" rendered `shouldBe` False
hasKey "explain" rendered `shouldBe` False
hasKey "version" rendered `shouldBe` False
hasKey "seq_no_primary_term" rendered `shouldBe` False
hasKey "terminate_after" rendered `shouldBe` False
hasKey "stats" rendered `shouldBe` False
hasKey "search_pipeline" rendered `shouldBe` False
hasKey "stored_fields" rendered `shouldBe` False
describe "Search body JSON: every new field populated" $ do
it "renders all ten new wire keys simultaneously" $ do
let s =
(mkSearch Nothing Nothing)
{ trackTotalHits = Just (TrackTotalHitsUpTo 1000),
timeout = Just "5s",
minScore = Just 1.0,
explain = Just True,
searchVersion = Just False,
seqNoPrimaryTerm = Just True,
terminateAfter = Just 50,
stats = Just ["foo"],
searchPipeline = Just "pipeline-x",
storedFields = Just [FieldName "a"]
}
case toJSON s of
Object o -> do
-- Exactly the 10 new keys + from + size + track_scores = 13 keys total.
length (KM.keys o) `shouldBe` 13
mapM_
(\k -> KM.member (K.fromText k) o `shouldBe` True)
[ "track_total_hits",
"timeout",
"min_score",
"explain",
"version",
"seq_no_primary_term",
"terminate_after",
"stats",
"search_pipeline",
"stored_fields"
]
_ -> error "expected object"
describe "Search body JSON: lenses" $ do
it "trackTotalHitsLens round-trips" $ do
let s = mkSearch Nothing Nothing & trackTotalHitsLens ?~ TrackTotalHitsAll
s ^. trackTotalHitsLens `shouldBe` Just TrackTotalHitsAll
it "searchVersionLens round-trips (disambiguates from Status.version)" $ do
let s = mkSearch Nothing Nothing & searchVersionLens ?~ True
s ^. searchVersionLens `shouldBe` Just True
it "every new lens defaults to Nothing in mkSearch output" $ do
let s = mkSearch Nothing Nothing :: Search
s ^. trackTotalHitsLens `shouldBe` Nothing
s ^. timeoutLens `shouldBe` Nothing
s ^. minScoreLens `shouldBe` Nothing
s ^. explainLens `shouldBe` Nothing
s ^. searchVersionLens `shouldBe` Nothing
s ^. seqNoPrimaryTermLens `shouldBe` Nothing
s ^. terminateAfterLens `shouldBe` Nothing
s ^. statsLens `shouldBe` Nothing
s ^. searchPipelineLens `shouldBe` Nothing
s ^. storedFieldsLens `shouldBe` Nothing
-- | Compare HashMaps by their key sets (order-independent).
sortKeys :: KM.KeyMap Value -> [K.Key]
sortKeys = sort . KM.keys
-- ---------------------------------------------------------------------------
-- bloodhound-04f.7.1.1: runtimeMappings
-- ---------------------------------------------------------------------------
specRuntimeMappings :: Spec
specRuntimeMappings = do
describe "RuntimeType JSON instances" $ do
it "renders every constructor as the expected lowercase string" $ do
toJSON RuntimeTypeBoolean `shouldBe` String "boolean"
toJSON RuntimeTypeDate `shouldBe` String "date"
toJSON RuntimeTypeDouble `shouldBe` String "double"
toJSON RuntimeTypeKeyword `shouldBe` String "keyword"
toJSON RuntimeTypeLong `shouldBe` String "long"
toJSON RuntimeTypeIP `shouldBe` String "ip"
it "FromJSON round-trips every constructor" $ do
decode (encode RuntimeTypeBoolean) `shouldBe` Just RuntimeTypeBoolean
decode (encode RuntimeTypeDate) `shouldBe` Just RuntimeTypeDate
decode (encode RuntimeTypeDouble) `shouldBe` Just RuntimeTypeDouble
decode (encode RuntimeTypeKeyword) `shouldBe` Just RuntimeTypeKeyword
decode (encode RuntimeTypeLong) `shouldBe` Just RuntimeTypeLong
decode (encode RuntimeTypeIP) `shouldBe` Just RuntimeTypeIP
describe "RuntimeScript JSON instances" $ do
it "round-trips with source only" $ do
let rs = RuntimeScript {runtimeScriptSource = "doc['x'].value", runtimeScriptParams = Nothing, runtimeScriptLang = Nothing}
decode (encode rs) `shouldBe` Just rs
it "round-trips with source + lang" $ do
let rs =
RuntimeScript
{ runtimeScriptSource = "emit(doc['x'].value * params['factor'])",
runtimeScriptParams = Nothing,
runtimeScriptLang = Just "painless"
}
decode (encode rs) `shouldBe` Just rs
it "uses the lang wire key" $ do
let rs = RuntimeScript "doc['x'].value" Nothing (Just "expression")
lookupKey "lang" (toJSON rs) `shouldBe` Just (String "expression")
describe "RuntimeMapping JSON instances" $ do
it "round-trips type-only mapping" $ do
let rm = RuntimeMapping {runtimeMappingType = RuntimeTypeKeyword, runtimeMappingScript = Nothing}
decode (encode rm) `shouldBe` Just rm
it "round-trips mapping with script" $ do
let rm =
RuntimeMapping
{ runtimeMappingType = RuntimeTypeLong,
runtimeMappingScript =
Just
RuntimeScript
{ runtimeScriptSource = "emit(doc['x'].value)",
runtimeScriptParams = Nothing,
runtimeScriptLang = Nothing
}
}
decode (encode rm) `shouldBe` Just rm
describe "RuntimeMappings JSON instances" $ do
it "renders as a bare JSON object keyed by field name" $ do
let rms =
RuntimeMappings $
singleton
"day_of_week"
RuntimeMapping
{ runtimeMappingType = RuntimeTypeKeyword,
runtimeMappingScript =
Just
RuntimeScript
{ runtimeScriptSource = "emit(doc['timestamp'].value.dayOfWeekEnum)",
runtimeScriptParams = Nothing,
runtimeScriptLang = Nothing
}
}
case toJSON rms of
Object o -> do
KM.member (K.fromText "day_of_week") o `shouldBe` True
_ -> error "expected object"
it "round-trips a single-entry map" $ do
let rms =
RuntimeMappings $
singleton "qoy" $
RuntimeMapping
{ runtimeMappingType = RuntimeTypeDouble,
runtimeMappingScript = Nothing
}
decode (encode rms) `shouldBe` Just rms
describe "Search body JSON: runtimeMappings field" $ do
let base = mkSearch Nothing Nothing :: Search
it "omits runtime_mappings when Nothing" $ do
hasKey "runtime_mappings" (toJSON base) `shouldBe` False
it "renders runtime_mappings when set" $ do
let s =
base
{ runtimeMappings =
Just $
RuntimeMappings $
singleton "day_of_week" $
RuntimeMapping
{ runtimeMappingType = RuntimeTypeKeyword,
runtimeMappingScript = Nothing
}
}
hasKey "runtime_mappings" (toJSON s) `shouldBe` True
it "runtimeMappingsLens round-trips" $ do
let s = mkSearch Nothing Nothing & runtimeMappingsLens ?~ RuntimeMappings (singleton "x" (RuntimeMapping RuntimeTypeBoolean Nothing))
s ^. runtimeMappingsLens
`shouldBe` Just (RuntimeMappings (singleton "x" (RuntimeMapping RuntimeTypeBoolean Nothing)))
-- ---------------------------------------------------------------------------
-- bloodhound-04f.7.1.2: rescore
-- ---------------------------------------------------------------------------
specRescore :: Spec
specRescore = do
describe "RescoreScoreMode JSON instances" $ do
it "renders every constructor as the expected string" $ do
toJSON RescoreScoreModeAvg `shouldBe` String "avg"
toJSON RescoreScoreModeMax `shouldBe` String "max"
toJSON RescoreScoreModeMin `shouldBe` String "min"
toJSON RescoreScoreModeTotal `shouldBe` String "total"
toJSON RescoreScoreModeMultiply `shouldBe` String "multiply"
it "FromJSON round-trips every constructor" $ do
decode (encode RescoreScoreModeAvg) `shouldBe` Just RescoreScoreModeAvg
decode (encode RescoreScoreModeMax) `shouldBe` Just RescoreScoreModeMax
decode (encode RescoreScoreModeMin) `shouldBe` Just RescoreScoreModeMin
decode (encode RescoreScoreModeTotal) `shouldBe` Just RescoreScoreModeTotal
decode (encode RescoreScoreModeMultiply) `shouldBe` Just RescoreScoreModeMultiply
it "FromJSON accepts sum as an alias for total" $ do
decode "\"sum\"" `shouldBe` Just RescoreScoreModeTotal
describe "RescoreQuery JSON instances" $ do
it "round-trips a minimal rescore query" $ do
let rq =
RescoreQuery
{ rescoreQueryRescoreQuery = MatchAllQuery Nothing,
rescoreQueryQueryWeight = Nothing,
rescoreQueryRescoreQueryWeight = Nothing,
rescoreQueryScoreMode = Nothing
}
decode (encode rq) `shouldBe` Just rq
it "round-trips a fully-populated rescore query" $ do
let rq =
RescoreQuery
{ rescoreQueryRescoreQuery = MatchAllQuery Nothing,
rescoreQueryQueryWeight = Just 0.7,
rescoreQueryRescoreQueryWeight = Just 1.2,
rescoreQueryScoreMode = Just RescoreScoreModeMax
}
decode (encode rq) `shouldBe` Just rq
it "uses the rescore_query wire key" $ do
lookupKey "rescore_query" (toJSON (RescoreQuery (MatchAllQuery Nothing) Nothing Nothing Nothing))
`shouldBe` Just (toJSON (MatchAllQuery Nothing :: Query))
it "uses the score_mode wire key" $ do
lookupKey "score_mode" (toJSON (RescoreQuery (MatchAllQuery Nothing) Nothing Nothing (Just RescoreScoreModeAvg)))
`shouldBe` Just (String "avg")
describe "Rescore JSON instances" $ do
it "round-trips a rescore clause" $ do
let r =
Rescore
{ rescoreWindowSize = Just 100,
rescoreQueryBody =
RescoreQuery
{ rescoreQueryRescoreQuery = MatchAllQuery Nothing,
rescoreQueryQueryWeight = Just 0.5,
rescoreQueryRescoreQueryWeight = Nothing,
rescoreQueryScoreMode = Just RescoreScoreModeTotal
}
}
decode (encode r) `shouldBe` Just r
it "uses the window_size wire key" $ do
lookupKey "window_size" (toJSON (Rescore (Just 50) (RescoreQuery (MatchAllQuery Nothing) Nothing Nothing Nothing)))
`shouldBe` Just (Number 50)
it "uses the query wire key" $ do
hasKey "query" (toJSON (Rescore Nothing (RescoreQuery (MatchAllQuery Nothing) Nothing Nothing Nothing)))
`shouldBe` True
describe "Search body JSON: rescore field" $ do
let base = mkSearch Nothing Nothing :: Search
it "omits rescore when Nothing" $ do
hasKey "rescore" (toJSON base) `shouldBe` False
it "renders rescore as a JSON array when set" $ do
let s =
base
{ rescore =
Just
[ Rescore
{ rescoreWindowSize = Just 10,
rescoreQueryBody =
RescoreQuery
{ rescoreQueryRescoreQuery = MatchAllQuery Nothing,
rescoreQueryQueryWeight = Nothing,
rescoreQueryRescoreQueryWeight = Nothing,
rescoreQueryScoreMode = Just RescoreScoreModeAvg
}
}
]
}
rendered = toJSON s
isRescoreArray = case lookupKey "rescore" rendered of
Just (Array _) -> True
_ -> False
isRescoreArray `shouldBe` True
it "rescoreLens round-trips" $ do
let clause = Rescore Nothing (RescoreQuery (MatchAllQuery Nothing) Nothing Nothing Nothing)
s = mkSearch Nothing Nothing & rescoreLens ?~ [clause]
s ^. rescoreLens `shouldBe` Just [clause]
-- ---------------------------------------------------------------------------
-- bloodhound-04f.7.1.3: collapse
-- ---------------------------------------------------------------------------
specCollapse :: Spec
specCollapse = do
describe "CollapseInnerHits JSON instances" $ do
it "round-trips an empty config" $ do
let ih = CollapseInnerHits {collapseInnerHitsName = Nothing, collapseInnerHitsSize = Nothing, collapseInnerHitsFrom = Nothing, collapseInnerHitsCollapse = Nothing}
decode (encode ih) `shouldBe` Just ih
it "round-trips a populated config" $ do
let ih =
CollapseInnerHits
{ collapseInnerHitsName = Just "latest_per_group",
collapseInnerHitsSize = Just 3,
collapseInnerHitsFrom = Just (From 0),
collapseInnerHitsCollapse = Nothing
}
decode (encode ih) `shouldBe` Just ih
it "uses the name and size wire keys" $ do
let ih = CollapseInnerHits {collapseInnerHitsName = Just "g1", collapseInnerHitsSize = Just 5, collapseInnerHitsFrom = Nothing, collapseInnerHitsCollapse = Nothing}
lookupKey "name" (toJSON ih) `shouldBe` Just (String "g1")
lookupKey "size" (toJSON ih) `shouldBe` Just (Number 5)
describe "Collapse JSON instances" $ do
it "round-trips a minimal collapse" $ do
let c =
Collapse
{ collapseField = FieldName "category",
collapseInnerHits = Nothing,
collapseMaxConcurrentGroupSearches = Nothing
}
decode (encode c) `shouldBe` Just c
it "round-trips a populated collapse with inner_hits and max_concurrent" $ do
let c =
Collapse
{ collapseField = FieldName "user.id",
collapseInnerHits =
Just
[ CollapseInnerHits
{ collapseInnerHitsName = Just "last_tweets",
collapseInnerHitsSize = Just 5,
collapseInnerHitsFrom = Nothing,
collapseInnerHitsCollapse = Nothing
}
],
collapseMaxConcurrentGroupSearches = Just 4
}
decode (encode c) `shouldBe` Just c
it "round-trips nested collapse inside inner_hits (ES-correct shape)" $ do
let innerCollapse =
Collapse
{ collapseField = FieldName "user.id",
collapseInnerHits = Nothing,
collapseMaxConcurrentGroupSearches = Nothing
}
ih =
CollapseInnerHits
{ collapseInnerHitsName = Just "by_location",
collapseInnerHitsSize = Just 3,
collapseInnerHitsFrom = Nothing,
collapseInnerHitsCollapse = Just innerCollapse
}
outer =
Collapse
{ collapseField = FieldName "geo.country_name",
collapseInnerHits = Just [ih],
collapseMaxConcurrentGroupSearches = Nothing
}
decode (encode outer) `shouldBe` Just outer
it "uses the field wire key" $ do
lookupKey "field" (toJSON (Collapse (FieldName "host.name") Nothing Nothing))
`shouldBe` Just (String "host.name")
it "uses the max_concurrent_group_searches wire key" $ do
lookupKey "max_concurrent_group_searches" (toJSON (Collapse (FieldName "x") Nothing (Just 8)))
`shouldBe` Just (Number 8)
describe "Search body JSON: collapse field" $ do
let base = mkSearch Nothing Nothing :: Search
it "omits collapse when Nothing" $ do
hasKey "collapse" (toJSON base) `shouldBe` False
it "renders collapse when set" $ do
let s = base {collapse = Just (Collapse (FieldName "user.id") Nothing Nothing)}
hasKey "collapse" (toJSON s) `shouldBe` True
it "collapseLens round-trips" $ do
let c = Collapse (FieldName "x") Nothing Nothing
s = mkSearch Nothing Nothing & collapseLens ?~ c
s ^. collapseLens `shouldBe` Just c
-- ---------------------------------------------------------------------------
-- bloodhound-04f.5.8.1: retrievers
-- ---------------------------------------------------------------------------
specRetriever :: Spec
specRetriever = do
describe "StandardRetriever JSON instances" $ do
it "round-trips an empty config (query=Nothing renders as omitNulls elision)" $ do
let sr = mkStandardRetriever Nothing
decode (encode sr) `shouldBe` Just sr
it "round-trips a populated config" $ do
let sr = mkStandardRetriever (Just (MatchAllQuery Nothing))
decode (encode sr) `shouldBe` Just sr
it "round-trips a fully-populated config (RetrieverBase + sort/collapse/search_after/terminate_after)" $ do
let sr =
(mkStandardRetriever (Just (MatchAllQuery Nothing)))
{ srBase =
emptyRetrieverBase
{ rbMinScore = Just 0.5,
rbName = Just "my-standard"
},
srSearchAfter = Just [Number 1, String "abc"],
srTerminateAfter = Just 100,
srCollapse = Just (RetrieverCollapse (object ["field" .= String "user"])),
srSort = Just (toJSON ([DefaultSortSpec (mkSort (FieldName "ts") Descending)] :: Sort))
}
decode (encode sr) `shouldBe` Just sr
it "uses the query wire key and does not emit fields" $ do
let sr = mkStandardRetriever (Just (MatchAllQuery Nothing))
lookupKey "query" (toJSON sr) `shouldBe` Just (toJSON (MatchAllQuery Nothing :: Query))
-- The ES _types.StandardRetriever has no "fields" property (it lives
-- only on RRFRetriever); pin that it is never emitted.
hasKey "fields" (toJSON sr) `shouldBe` False
it "DECODER FIXTURE: minimal standard retriever from ES docs" $ do
-- Matches the shape in the ES Retrievers docs:
-- { "standard": { "query": { "match_all": {} } } }
-- (Retriever wrapper tested under "Retriever sum-type wire shape")
(decode "{\"query\":{\"match_all\":{}}}" :: Maybe StandardRetriever)
`shouldBe` Just (mkStandardRetriever (Just (MatchAllQuery Nothing)))
describe "KnnRetriever JSON instances" $ do
it "round-trips a minimal config (field only)" $ do
let k = mkKnnRetriever (FieldName "embedding")
decode (encode k) `shouldBe` Just k
it "round-trips a fully-populated config" $ do
let k =
(mkKnnRetriever (FieldName "embedding"))
{ knnrQueryVector = Just [0.1, 0.2, 0.3],
knnrK = Just 5,
knnrNumCandidates = Just 50,
knnrSimilarity = Just 0.9,
knnrVisitPercentage = Just 0.2,
knnrRescoreVector = Just (RescoreVector 3.0)
}
decode (encode k) `shouldBe` Just k
it "uses the field/query_vector/k/num_candidates wire keys" $ do
let k = (mkKnnRetriever (FieldName "v")) {knnrQueryVector = Just [0.1], knnrK = Just 5, knnrNumCandidates = Just 10}
rendered = toJSON k
lookupKey "field" rendered `shouldBe` Just (String "v")
lookupKey "query_vector" rendered `shouldBe` Just (toJSON [0.1 :: Double])
lookupKey "k" rendered `shouldBe` Just (Number 5)
lookupKey "num_candidates" rendered `shouldBe` Just (Number 10)
-- boost and inner_hits are NOT valid on the knn retriever.
hasKey "boost" rendered `shouldBe` False
hasKey "inner_hits" rendered `shouldBe` False
it "DECODER FIXTURE: knn retriever body from ES docs" $ do
(decode "{\"field\":\"v\",\"query_vector\":[0.1,0.2],\"k\":10,\"num_candidates\":100}" :: Maybe KnnRetriever)
`shouldBe` Just
( (mkKnnRetriever (FieldName "v"))
{ knnrQueryVector = Just [0.1, 0.2],
knnrK = Just 10,
knnrNumCandidates = Just 100
}
)
describe "TextSimilarityRetriever JSON instances" $ do
it "round-trips a minimal config (inference_id omitted)" $ do
let ts =
mkTextSimilarityRetriever
(RetrieverStandard (mkStandardRetriever Nothing))
(FieldName "semantic_text")
"what is bloodhound?"
decode (encode ts) `shouldBe` Just ts
it "round-trips a fully-populated config (incl. chunk_rescorer)" $ do
let ts =
( mkTextSimilarityRetriever
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
(FieldName "semantic_text")
"what is bloodhound?"
)
{ tsInferenceId = Just ".rerank_v1",
tsRankWindowSize = Just 100,
tsChunkRescorer =
Just
( ChunkRescorer
{ crSize = Just 2,
crChunkingSettings =
Just
( ChunkRescorerChunkingSettings
{ crcsMaxChunkSize = 250,
crcsOverlap = Just 50,
crcsSentenceOverlap = Nothing,
crcsSeparatorGroup = Nothing,
crcsSeparators = Nothing,
crcsStrategy = Just ChunkingStrategySentence
}
)
}
)
}
decode (encode ts) `shouldBe` Just ts
it "uses the retriever/field/inference_text/inference_id/rank_window_size wire keys" $ do
let ts = (mkTextSimilarityRetriever (RetrieverStandard (mkStandardRetriever Nothing)) (FieldName "f") "query text") {tsInferenceId = Just "mid", tsRankWindowSize = Just 50}
rendered = toJSON ts
hasKey "retriever" rendered `shouldBe` True
lookupKey "field" rendered `shouldBe` Just (String "f")
lookupKey "inference_text" rendered `shouldBe` Just (String "query text")
lookupKey "inference_id" rendered `shouldBe` Just (String "mid")
lookupKey "rank_window_size" rendered `shouldBe` Just (Number 50)
it "DECODER FIXTURE: text_similarity_reranker body from ES docs" $ do
( decode
"{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"field\":\"semantic_text\",\"inference_text\":\"what is bloodhound?\"}" ::
Maybe TextSimilarityRetriever
)
`shouldBe` Just
( mkTextSimilarityRetriever
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
(FieldName "semantic_text")
"what is bloodhound?"
)
it "rejects a body missing the required inference_text field" $ do
( decode
"{\"retriever\":{\"standard\":{}},\"field\":\"f\",\"inference_id\":\".rerank\"}" ::
Maybe TextSimilarityRetriever
)
`shouldBe` Nothing
describe "RrfRetriever JSON instances" $ do
it "round-trips a minimal config with bare entries" $ do
let rrf = mkRrfRetriever (RrfRetrieverEntryBare (RetrieverStandard (mkStandardRetriever Nothing)) :| [])
decode (encode rrf) `shouldBe` Just rrf
it "round-trips a fully-populated config (weighted + bare entries, query/fields)" $ do
let std = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
knn = RetrieverKnn ((mkKnnRetriever (FieldName "embedding")) {knnrQueryVector = Just [0.1, 0.2, 0.3], knnrK = Just 5})
rrf =
( mkRrfRetriever
( RrfRetrieverEntryWeighted std (Just 0.6)
:| [ RrfRetrieverEntryBare knn
]
)
)
{ rrfRankWindowSize = Just 100,
rrfRankConstant = Just 60,
rrfQuery = Just "elastic",
rrfFields = Just [FieldName "title"]
}
decode (encode rrf) `shouldBe` Just rrf
it "uses the retrievers / rank_window_size / rank_constant wire keys (no window_size)" $ do
let rrf = (mkRrfRetriever (RrfRetrieverEntryBare (RetrieverStandard (mkStandardRetriever Nothing)) :| [])) {rrfRankWindowSize = Just 20, rrfRankConstant = Just 60}
rendered = toJSON rrf
hasKey "retrievers" rendered `shouldBe` True
lookupKey "rank_window_size" rendered `shouldBe` Just (Number 20)
lookupKey "rank_constant" rendered `shouldBe` Just (Number 60)
hasKey "window_size" rendered `shouldBe` False
it "rejects an empty retrievers array (NonEmpty instance)" $ do
(decode "{\"retrievers\":[]}" :: Maybe RrfRetriever) `shouldBe` Nothing
it "RRFRetrieverEntry: bare entry decodes from a bare retriever object" $ do
(decode "{\"standard\":{\"query\":{\"match_all\":{}}}}" :: Maybe RrfRetrieverEntry)
`shouldBe` Just (RrfRetrieverEntryBare (RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))))
it "RRFRetrieverEntry: weighted entry decodes from {retriever, weight}" $ do
(decode "{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"weight\":2.0}" :: Maybe RrfRetrieverEntry)
`shouldBe` Just (RrfRetrieverEntryWeighted (RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))) (Just 2.0))
describe "RuleRetriever JSON instances" $ do
it "round-trips a populated config" $ do
let child = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
rule = mkRuleRetriever ("my-ruleset" :| []) (KM.fromList [(K.fromText "query", String "elastic")]) child
decode (encode rule) `shouldBe` Just rule
it "DECODER FIXTURE: decodes a single-string ruleset_ids into a NonEmpty" $ do
let body = "{\"ruleset_ids\":\"rs1\",\"match_criteria\":{},\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}}}"
expected =
mkRuleRetriever
("rs1" :| [])
mempty
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
(decode body :: Maybe RuleRetriever) `shouldBe` Just expected
it "DECODER FIXTURE: decodes an array ruleset_ids" $ do
let body = "{\"ruleset_ids\":[\"rs1\",\"rs2\"],\"match_criteria\":{\"k\":\"v\"},\"retriever\":{\"standard\":{}},\"rank_window_size\":50}"
expected =
( mkRuleRetriever
("rs1" :| ["rs2"])
(KM.fromList [(K.fromText "k", String "v")])
(RetrieverStandard (mkStandardRetriever Nothing))
)
{ ruleRankWindowSize = Just 50
}
(decode body :: Maybe RuleRetriever) `shouldBe` Just expected
describe "RescorerRetriever JSON instances" $ do
it "round-trips a config with a single rescore clause" $ do
let child = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
rr = mkRescorerRetriever child (RetrieverRescore (object ["window_size" .= Number 10]) :| [])
decode (encode rr) `shouldBe` Just rr
it "DECODER FIXTURE: decodes a single-object rescore into a NonEmpty" $ do
let body = "{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"rescore\":{\"window_size\":10}}"
expected =
mkRescorerRetriever
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
(RetrieverRescore (object ["window_size" .= Number 10]) :| [])
(decode body :: Maybe RescorerRetriever) `shouldBe` Just expected
it "DECODER FIXTURE: decodes an array rescore" $ do
let body = "{\"retriever\":{\"standard\":{}},\"rescore\":[{\"window_size\":5},{\"window_size\":10}]}"
(decode body :: Maybe RescorerRetriever) `shouldNotBe` Nothing
describe "LinearRetriever JSON instances" $ do
it "round-trips a populated config" $ do
let child = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
entry = LinearRetrieverEntry child 0.7 MinMaxNormalizer
lin = (mkLinearRetriever [entry]) {linearRankWindowSize = Just 100, linearNormalizer = Just L2NormNormalizer}
decode (encode lin) `shouldBe` Just lin
it "uses the retrievers/weight/normalizer wire keys per entry" $ do
let child = RetrieverStandard (mkStandardRetriever Nothing)
rendered = toJSON (LinearRetrieverEntry child 0.5 NoNormalizer)
hasKey "retriever" rendered `shouldBe` True
lookupKey "weight" rendered `shouldBe` Just (Number 0.5)
lookupKey "normalizer" rendered `shouldBe` Just (String "none")
it "ScoreNormalizer round-trips every constructor" $ do
decode (encode NoNormalizer) `shouldBe` Just NoNormalizer
decode (encode MinMaxNormalizer) `shouldBe` Just MinMaxNormalizer
decode (encode L2NormNormalizer) `shouldBe` Just L2NormNormalizer
describe "PinnedRetriever JSON instances" $ do
it "round-trips a config with ids + docs" $ do
let Right idx = mkIndexName "my-index"
child = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
pin =
(mkPinnedRetriever child)
{ pinnedIds = Just ["doc1", "doc2"],
pinnedDocs = Just [SpecifiedDocument (Just idx) (DocId "doc3")],
pinnedRankWindowSize = Just 50
}
decode (encode pin) `shouldBe` Just pin
it "SpecifiedDocument renders _id and _index wire keys" $ do
let Right idx = mkIndexName "my-index"
rendered = toJSON (SpecifiedDocument (Just idx) (DocId "doc1"))
lookupKey "_id" rendered `shouldBe` Just (String "doc1")
lookupKey "_index" rendered `shouldBe` Just (String "my-index")
describe "DiversifyRetriever JSON instances" $ do
it "round-trips a fully-populated MMR config" $ do
let child = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
div =
(mkDiversifyRetriever (FieldName "category") child)
{ diversifySize = Just 10,
diversifyRankWindowSize = Just 100,
diversifyQueryVector = Just [0.1, 0.2],
diversifyLambda = Just 0.5
}
decode (encode div) `shouldBe` Just div
it "DiversifyType renders and parses mmr" $ do
toJSON DiversifyMMR `shouldBe` String "mmr"
decode "\"mmr\"" `shouldBe` Just DiversifyMMR
(decode "\"unknown\"" :: Maybe DiversifyType) `shouldBe` Nothing
describe "Retriever sum-type wire shape" $ do
it "ENCODER FIXTURE: standard retriever renders as the ES-doc shape" $ do
decode (encode (RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))))
`shouldBe` ( decode
"{\"standard\":{\"query\":{\"match_all\":{}}}}" ::
Maybe Value
)
it "ENCODER FIXTURE: rrf retriever renders as the ES-doc shape" $ do
let rrf =
RetrieverRRF
( mkRrfRetriever
( RrfRetrieverEntryBare
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
:| [ RrfRetrieverEntryBare
( RetrieverKnn
( (mkKnnRetriever (FieldName "my-vector"))
{ knnrQueryVector = Just [0.1, 0.2],
knnrK = Just 10
}
)
)
]
)
)
{ rrfRankWindowSize = Just 50,
rrfRankConstant = Just 60
}
decode (encode rrf)
`shouldBe` ( decode
( "{\"rrf\":"
<> "{\"retrievers\":["
<> "{\"standard\":{\"query\":{\"match_all\":{}}}},"
<> "{\"knn\":{\"field\":\"my-vector\",\"query_vector\":[0.1,0.2],\"k\":10}}"
<> "],"
<> "\"rank_window_size\":50,"
<> "\"rank_constant\":60"
<> "}}"
) ::
Maybe Value
)
it "DECODER FIXTURE: standard retriever decodes from canonical ES JSON" $ do
(decode "{\"standard\":{\"query\":{\"match_all\":{}}}}" :: Maybe Retriever)
`shouldBe` Just (RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
it "DECODER FIXTURE: text_similarity_reranker uses the post-8.14 key (not text_similarity)" $ do
let body =
"{\"text_similarity_reranker\":{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"field\":\"semantic_text\",\"inference_text\":\"q\"}}"
(decode body :: Maybe Retriever)
`shouldBe` Just
( RetrieverTextSimilarity
( mkTextSimilarityRetriever
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
(FieldName "semantic_text")
"q"
)
)
it "DECODER FIXTURE: rule retriever decodes from canonical ES JSON" $ do
let body =
"{\"rule\":{\"ruleset_ids\":\"rs\",\"match_criteria\":{},\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}}}}"
(decode body :: Maybe Retriever)
`shouldBe` Just
( RetrieverRule
( mkRuleRetriever
("rs" :| [])
mempty
(RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing))))
)
)
it "DECODER FIXTURE: linear retriever decodes from canonical ES JSON" $ do
let body =
"{\"linear\":{\"retrievers\":[{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"weight\":1.0,\"normalizer\":\"none\"}]}}"
(decode body :: Maybe Retriever)
`shouldNotBe` Nothing
it "DECODER FIXTURE: pinned retriever decodes from canonical ES JSON" $ do
let body =
"{\"pinned\":{\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"ids\":[\"a\",\"b\"]}}"
(decode body :: Maybe Retriever) `shouldNotBe` Nothing
it "DECODER FIXTURE: diversify retriever decodes from canonical ES JSON" $ do
let body =
"{\"diversify\":{\"type\":\"mmr\",\"field\":\"cat\",\"retriever\":{\"standard\":{\"query\":{\"match_all\":{}}}},\"lambda\":0.5}}"
(decode body :: Maybe Retriever) `shouldNotBe` Nothing
it "REJECTS the pre-8.14 text_similarity key (renamed to text_similarity_reranker)" $ do
let body =
"{\"text_similarity\":{\"retriever\":{\"standard\":{}},\"field\":\"f\",\"inference_text\":\"q\"}}"
(decode body :: Maybe Retriever) `shouldBe` Nothing
it "rejects the legacy text_expansion key (not a retriever type in modern ES)" $ do
-- text_expansion is a Query DSL clause, not a retriever; it must
-- be wrapped inside a standard retriever's `query` field instead.
-- Verified against the ES9 OpenAPI spec
-- (_types.RetrieverContainer does not list text_expansion).
(decode "{\"text_expansion\":{\"query\":{}}}" :: Maybe Retriever) `shouldBe` Nothing
it "rejects an unknown retriever tag" $ do
(decode "{\"unknown\":{}}" :: Maybe Retriever) `shouldBe` Nothing
it "rejects a multi-key object" $ do
(decode "{\"standard\":{},\"rrf\":{}}" :: Maybe Retriever) `shouldBe` Nothing
it "round-trips every constructor through ToJSON/FromJSON" $ do
let standard = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
knn = RetrieverKnn ((mkKnnRetriever (FieldName "embedding")) {knnrQueryVector = Just [0.1, 0.2, 0.3], knnrK = Just 5})
rrfInner = (mkRrfRetriever (RrfRetrieverEntryBare standard :| [RrfRetrieverEntryBare knn])) {rrfRankWindowSize = Just 100, rrfRankConstant = Just 60}
rrf = RetrieverRRF rrfInner
tsInner = (mkTextSimilarityRetriever standard (FieldName "sem") "query text") {tsInferenceId = Just ".rerank", tsRankWindowSize = Just 100}
ts = RetrieverTextSimilarity tsInner
rule = RetrieverRule (mkRuleRetriever ("rs" :| []) mempty standard)
rescorer = RetrieverRescorer (mkRescorerRetriever standard (RetrieverRescore (object ["window_size" .= Number 10]) :| []))
lin = RetrieverLinear (mkLinearRetriever [LinearRetrieverEntry standard 1.0 NoNormalizer])
pin = RetrieverPinned ((mkPinnedRetriever standard) {pinnedIds = Just ["a"]})
div = RetrieverDiversify ((mkDiversifyRetriever (FieldName "c") standard) {diversifyLambda = Just 0.5})
decode (encode standard) `shouldBe` Just standard
decode (encode knn) `shouldBe` Just knn
decode (encode rrf) `shouldBe` Just rrf
decode (encode ts) `shouldBe` Just ts
decode (encode rule) `shouldBe` Just rule
decode (encode rescorer) `shouldBe` Just rescorer
decode (encode lin) `shouldBe` Just lin
decode (encode pin) `shouldBe` Just pin
decode (encode div) `shouldBe` Just div
it "round-trips a 3-level nested tree (RRF(weighted) -> rule -> standard)" $ do
let leaf = RetrieverStandard (mkStandardRetriever (Just (MatchAllQuery Nothing)))
rule = RetrieverRule (mkRuleRetriever ("rs" :| []) mempty leaf)
tree =
RetrieverRRF
( mkRrfRetriever
(RrfRetrieverEntryWeighted leaf (Just 0.5) :| [RrfRetrieverEntryBare rule])
)
decode (encode tree) `shouldBe` Just tree
describe "Search body JSON: retriever field" $ do
let base = mkSearch Nothing Nothing :: Search
it "omits retriever when Nothing" $ do
hasKey "retriever" (toJSON base) `shouldBe` False
it "renders retriever when set" $ do
let s = base {retriever = Just (RetrieverStandard (mkStandardRetriever Nothing))}
hasKey "retriever" (toJSON s) `shouldBe` True
it "mkSearch default shape is still byte-identical (retriever elided by omitNulls)" $ do
encode (mkSearch Nothing Nothing :: Search)
`shouldBe` "{\"from\":0,\"size\":10,\"track_scores\":false}"
it "retrieverLens round-trips" $ do
let r = RetrieverStandard (mkStandardRetriever Nothing)
s = mkSearch Nothing Nothing & retrieverLens ?~ r
s ^. retrieverLens `shouldBe` Just r
it "retrieverLens defaults to Nothing in mkSearch output" $ do
let s = mkSearch Nothing Nothing :: Search
s ^. retrieverLens `shouldBe` Nothing