packages feed

bloodhound-1.0.0.0: tests/Test/AsyncSearchSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Test.AsyncSearchSpec (spec) where

import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List (sort)
import Data.Map.Strict qualified as M
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Common
import TestsUtils.Import
import Prelude

-- | Fixture mimicking a still-running async search (no @id@ yet, no
-- @took@\/@_shards@\/@hits@). Adapted from the example at
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/async-search.html#submit-async-search>.
sampleRunningResponse :: LBS.ByteString
sampleRunningResponse =
  "{\
  \  \"is_running\": true,\
  \  \"is_partial\": true,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000\
  \}"

-- | Fixture mimicking a completed async search: full @hits@, @took@,
-- @_shards@, an @id@ for polling, and a single-bucket @aggregations@ block.
-- The @hit._source@ values are typed as 'Value' so the test does not need a
-- domain model.
sampleCompletedResponse :: LBS.ByteString
sampleCompletedResponse =
  "{\
  \  \"id\": \"FmRleEctRXJtaVNZQ1I2UkJoTDJfQkEAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3ZwAAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3Zw==\",\
  \  \"is_running\": false,\
  \  \"is_partial\": false,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000,\
  \  \"took\": 5,\
  \  \"timed_out\": false,\
  \  \"num_reduce_phases\": 1,\
  \  \"_shards\": {\"total\": 1, \"successful\": 1, \"skipped\": 0, \"failed\": 0},\
  \  \"hits\": {\
  \    \"total\": {\"value\": 2, \"relation\": \"eq\"},\
  \    \"max_score\": 1.0,\
  \    \"hits\": [\
  \      {\"_index\": \"my-index-000001\", \"_id\": \"1\", \"_score\": 1.0, \"_source\": {\"user\": \"bob\"}},\
  \      {\"_index\": \"my-index-000001\", \"_id\": \"2\", \"_score\": 1.0, \"_source\": {\"user\": \"ana\"}}\
  \    ]\
  \  },\
  \  \"aggregations\": {\"by_user\": {\"doc_count_error_upper_bound\": 0, \"sum_other_doc_count\": 0, \"buckets\": []}}\
  \}"

-- | Fixture mimicking the body returned by Elasticsearch 8.x\/9.x (and
-- modern 7.x patches) once the async search has completed: the search
-- payload (@took@, @_shards@, @hits@, @aggregations@, ...) is nested
-- under a top-level @response@ object, and the scheduling fields
-- (@id@, @is_running@, ...) plus @completion_time_in_millis@ sit at the
-- top level. Same data as 'sampleCompletedResponse' so the two shapes are
-- directly comparable. OpenSearch returns the flat shape instead.
sampleCompletedResponseNested :: LBS.ByteString
sampleCompletedResponseNested =
  "{\
  \  \"id\": \"FmRleEctRXJtaVNZQ1I2UkJoTDJfQkEAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3ZwAAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3Zw==\",\
  \  \"is_running\": false,\
  \  \"is_partial\": false,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000,\
  \  \"completion_time_in_millis\": 1584726302000,\
  \  \"response\": {\
  \    \"took\": 5,\
  \    \"timed_out\": false,\
  \    \"num_reduce_phases\": 1,\
  \    \"_shards\": {\"total\": 1, \"successful\": 1, \"skipped\": 0, \"failed\": 0},\
  \    \"hits\": {\
  \      \"total\": {\"value\": 2, \"relation\": \"eq\"},\
  \      \"max_score\": 1.0,\
  \      \"hits\": [\
  \        {\"_index\": \"my-index-000001\", \"_id\": \"1\", \"_score\": 1.0, \"_source\": {\"user\": \"bob\"}},\
  \        {\"_index\": \"my-index-000001\", \"_id\": \"2\", \"_score\": 1.0, \"_source\": {\"user\": \"ana\"}}\
  \      ]\
  \    },\
  \    \"aggregations\": {\"by_user\": {\"doc_count_error_upper_bound\": 0, \"sum_other_doc_count\": 0, \"buckets\": []}}\
  \  }\
  \}"

-- | Fixture mimicking the body returned by @GET /_async_search/status/{id}@
-- while the search is still running: only the running\/partial flags and
-- the two scheduling timestamps, no @id@, @took@, @_shards@, @hits@ or
-- @aggregations@. Adapted from
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/async-search.html#get-async-search-status>.
sampleRunningStatusResponse :: LBS.ByteString
sampleRunningStatusResponse =
  "{\
  \  \"is_running\": true,\
  \  \"is_partial\": true,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000\
  \}"

-- | Fixture mimicking the status body once the async search has completed.
sampleCompletedStatusResponse :: LBS.ByteString
sampleCompletedStatusResponse =
  "{\
  \  \"is_running\": false,\
  \  \"is_partial\": false,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000,\
  \  \"completion_status\": 200\
  \}"

-- | Fixture mimicking the status body once the async search has completed,
-- including the @completion_time_in_millis@ timestamp the server stamps on
-- completion (alongside @completion_status@).
sampleCompletedStatusResponseWithCompletionTime :: LBS.ByteString
sampleCompletedStatusResponseWithCompletionTime =
  "{\
  \  \"is_running\": false,\
  \  \"is_partial\": false,\
  \  \"start_time_in_millis\": 1584726301000,\
  \  \"expiration_time_in_millis\": 1584812701000,\
  \  \"completion_time_in_millis\": 1584726302000,\
  \  \"completion_status\": 200\
  \}"

spec :: Spec
spec = describe "Async Search API" $ do
  describe "deleteAsyncSearch endpoint shape" $ do
    -- Pure checks against the BHRequest shape; no live backend needed.
    it "DELETEs /_async_search/{id} when given an AsyncSearchId" $ do
      let req = Common.deleteAsyncSearch (AsyncSearchId "FmRleEct")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "FmRleEct"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "does not attach a body (DELETE semantics)" $ do
      let req = Common.deleteAsyncSearch (AsyncSearchId "FmRleEct")
      bhRequestBody req `shouldBe` Nothing

    it "uses a distinct id in the path when given a different AsyncSearchId" $ do
      let req = Common.deleteAsyncSearch (AsyncSearchId "other-id")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "other-id"]

  describe "getAsyncSearch endpoint shape" $ do
    -- Pure checks against the BHRequest shape; no live backend needed.
    it "GETs /_async_search/{id} when given an AsyncSearchId" $ do
      let req = Common.getAsyncSearch @Value (AsyncSearchId "FmRleEct")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "FmRleEct"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "uses GET and attaches no body" $ do
      let req = Common.getAsyncSearch @Value (AsyncSearchId "FmRleEct")
      bhRequestMethod req `shouldBe` "GET"
      bhRequestBody req `shouldBe` Nothing

    it "keeps the id as a single opaque path segment" $ do
      let req = Common.getAsyncSearch @Value (AsyncSearchId "Fm_==_RxD_123")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "Fm_==_RxD_123"]

  describe "getAsyncSearchStatus endpoint shape" $ do
    -- Pure checks against the BHRequest shape; no live backend needed.
    it "GETs /_async_search/status/{id} when given an AsyncSearchId" $ do
      let req = Common.getAsyncSearchStatus (AsyncSearchId "FmRleEct")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "status", "FmRleEct"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "uses GET and attaches no body" $ do
      let req = Common.getAsyncSearchStatus (AsyncSearchId "FmRleEct")
      bhRequestMethod req `shouldBe` "GET"
      bhRequestBody req `shouldBe` Nothing

    it "uses a distinct id in the path when given a different AsyncSearchId" $ do
      let req = Common.getAsyncSearchStatus (AsyncSearchId "other-id")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "status", "other-id"]

    it "keeps the id as a single opaque path segment" $ do
      let req = Common.getAsyncSearchStatus (AsyncSearchId "Fm_==_RxD_123")
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search", "status", "Fm_==_RxD_123"]

  describe "getAsyncSearchStatus (live)" $ do
    it' <- runIO esOnlyIT
    it' "surfaces a server error for a non-existent async search id" $
      withTestEnv $ do
        -- ES rejects malformed ids with 400 (it validates the id format)
        -- rather than 404, so we only assert that an EsError is surfaced
        -- and no bogus status is returned.
        result <-
          tryEsError
            ( performBHRequest $
                Common.getAsyncSearchStatus
                  (AsyncSearchId "bloodhound-no-such-async-search-04f-5-1-3")
            )
        case result of
          Left _err -> pure ()
          Right r ->
            liftIO $
              expectationFailure $
                "expected EsError for missing async search, got: " <> show r

  describe "AsyncSearchStatus JSON" $ do
    it "decodes a running status body (no timing fields omitted here)" $ do
      let Just (decoded :: AsyncSearchStatus) = decode sampleRunningStatusResponse
      asyncSearchStatusIsRunning decoded `shouldBe` True
      asyncSearchStatusIsPartial decoded `shouldBe` True
      asyncSearchStatusStartTimeInMillis decoded `shouldBe` Just 1584726301000
      asyncSearchStatusExpirationTimeInMillis decoded `shouldBe` Just 1584812701000
      -- A still-running search has not produced an HTTP completion code,
      -- so completion_status is omitted by the server and decodes to Nothing.
      asyncSearchStatusCompletionStatus decoded `shouldBe` Nothing

    it "decodes a completed status body" $ do
      let Just (decoded :: AsyncSearchStatus) = decode sampleCompletedStatusResponse
      asyncSearchStatusIsRunning decoded `shouldBe` False
      asyncSearchStatusIsPartial decoded `shouldBe` False
      asyncSearchStatusCompletionStatus decoded `shouldBe` Just 200
      -- This fixture omits completion_time_in_millis, so the new field
      -- decodes to Nothing (the field appears only on completion).
      asyncSearchStatusCompletionTimeInMillis decoded `shouldBe` Nothing

    it "decodes a non-2xx completion_status (search finished with an error)" $ do
      -- completion_status is a plain HTTP code, so a failed-completion
      -- body surfaces e.g. 404 verbatim rather than collapsing to Nothing.
      let body =
            "{\
            \  \"is_running\": false,\
            \  \"is_partial\": false,\
            \  \"completion_status\": 404\
            \}"
          Just (decoded :: AsyncSearchStatus) = decode body
      asyncSearchStatusCompletionStatus decoded `shouldBe` Just 404

    it "decodes an empty {} response with the documented defaults" $ do
      -- is_running defaults to False and is_partial to True, mirroring the
      -- AsyncSearchResult FromJSON. The two timing fields and the
      -- completion_status field (only present once the search completes,
      -- since ES 7.13) all stay at Nothing.
      let Just (decoded :: AsyncSearchStatus) = decode "{}"
      asyncSearchStatusIsRunning decoded `shouldBe` False
      asyncSearchStatusIsPartial decoded `shouldBe` True
      asyncSearchStatusStartTimeInMillis decoded `shouldBe` Nothing
      asyncSearchStatusExpirationTimeInMillis decoded `shouldBe` Nothing
      asyncSearchStatusCompletionStatus decoded `shouldBe` Nothing

    it "tolerates unknown extra fields in the body" $ do
      let Just (decoded :: AsyncSearchStatus) =
            decode "{ \"is_running\": true, \"future_field\": \"whatever\" }"
      asyncSearchStatusIsRunning decoded `shouldBe` True

  describe "getAsyncSearch (live)" $ do
    it' <- runIO esOnlyIT
    it' "surfaces a server error for a non-existent async search id" $
      withTestEnv $ do
        -- ES rejects malformed ids with 400 (it validates the id format)
        -- rather than 404, so we only assert that an EsError is surfaced
        -- and no bogus result is returned.
        result <-
          tryEsError
            ( performBHRequest $
                Common.getAsyncSearch @Value
                  (AsyncSearchId "bloodhound-no-such-async-search-04f-5-1-2")
            )
        case result of
          Left _err -> pure ()
          Right r ->
            liftIO $
              expectationFailure $
                "expected EsError for missing async search, got: " <> show r

  describe "submitAsyncSearch endpoint shape" $ do
    -- Pure checks against the BHRequest shape; no live backend needed.
    it "POSTs to /_async_search with no query string" $ do
      let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing
          req = Common.submitAsyncSearch @Value search
      bhRequestMethod req `shouldBe` "POST"
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_async_search"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "attaches the encoded Search as the JSON body" $ do
      let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing
          req = Common.submitAsyncSearch @Value search
      bhRequestBody req `shouldBe` Just (encode search)

    it "tracks the input Search: a different query yields a different body" $ do
      let reqA = Common.submitAsyncSearch @Value (mkSearch (Just (MatchAllQuery Nothing)) Nothing)
          reqB = Common.submitAsyncSearch @Value (mkSearch (Just (TermQuery (Term "user" "bob") Nothing)) Nothing)
      bhRequestBody reqA `shouldNotBe` bhRequestBody reqB

  describe "submitAsyncSearchWith URI parameters" $ do
    -- Pure checks against the BHRequest shape; no live backend needed.
    -- The order of query parameters is unspecified (see the
    -- 'asyncSearchSubmitOptionsParams' docs), so any test asserting more
    -- than one parameter sorts both sides before comparing.
    let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing

    it "defaultAsyncSearchSubmitOptions emits no params" $ do
      let req = Common.submitAsyncSearchWith @Value defaultAsyncSearchSubmitOptions search
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "defaultAsyncSearchSubmitOptions is byte-identical to submitAsyncSearch" $ do
      let reqPlain = Common.submitAsyncSearch @Value search
          reqDef = Common.submitAsyncSearchWith @Value defaultAsyncSearchSubmitOptions search
      bhRequestMethod reqPlain `shouldBe` bhRequestMethod reqDef
      getRawEndpoint (bhRequestEndpoint reqPlain) `shouldBe` getRawEndpoint (bhRequestEndpoint reqDef)
      getRawEndpointQueries (bhRequestEndpoint reqPlain) `shouldBe` getRawEndpointQueries (bhRequestEndpoint reqDef)
      bhRequestBody reqPlain `shouldBe` bhRequestBody reqDef

    it "forwards wait_for_completion=true" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoWaitForCompletion = Just True}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("wait_for_completion", Just "true")]

    it "forwards wait_for_completion=false" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoWaitForCompletion = Just False}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("wait_for_completion", Just "false")]

    it "forwards keep_on_completion=true" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoKeepOnCompletion = Just True}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("keep_on_completion", Just "true")]

    it "forwards keep_alive as the KeepAlive wire format" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoKeepAlive = Just (keepAliveDays 5)}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("keep_alive", Just "5d")]

    it "forwards batched_reduce_size as a decimal string" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoBatchedReduceSize = Just 12}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("batched_reduce_size", Just "12")]

    it "renders batched_reduce_size=0 faithfully (no off-by-one)" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoBatchedReduceSize = Just 0}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("batched_reduce_size", Just "0")]

    it "forwards ccs_minimize_roundtrips=true" $ do
      let opts = defaultAsyncSearchSubmitOptions {assoCcsMinimizeRoundtrips = Just True}
          req = Common.submitAsyncSearchWith @Value opts search
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldBe` [("ccs_minimize_roundtrips", Just "true")]

    it "forwards every parameter at once (set semantics — order-insensitive)" $ do
      let opts =
            defaultAsyncSearchSubmitOptions
              { assoWaitForCompletion = Just True,
                assoKeepOnCompletion = Just True,
                assoKeepAlive = Just (keepAliveHours 1),
                assoBatchedReduceSize = Just 3,
                assoCcsMinimizeRoundtrips = Just False
              }
          req = Common.submitAsyncSearchWith @Value opts search
      sort (getRawEndpointQueries (bhRequestEndpoint req))
        `shouldBe` sort
          [ ("wait_for_completion", Just "true"),
            ("keep_on_completion", Just "true"),
            ("keep_alive", Just "1h"),
            ("batched_reduce_size", Just "3"),
            ("ccs_minimize_roundtrips", Just "false")
          ]

  describe "deleteAsyncSearch response decode" $ do
    it "decodes {\"acknowledged\": true} as Acknowledged True" $ do
      -- Pins the response type advertised by 'deleteAsyncSearch'.
      decode "{\"acknowledged\": true}" `shouldBe` Just (Acknowledged True)

  describe "AsyncSearchId JSON" $ do
    it "decodes a bare string" $ do
      decode "\"FmRleEct\"" `shouldBe` Just (AsyncSearchId "FmRleEct")

    it "encodes back to a bare string" $ do
      encode (AsyncSearchId "FmRleEct") `shouldBe` "\"FmRleEct\""

    it "round-trips through ToJSON/FromJSON" $ do
      let original = AsyncSearchId "FmRleEct"
      (decode . encode) original `shouldBe` Just original

  describe "AsyncSearchResult JSON" $ do
    it "decodes a still-running response (no id, no hits/took)" $ do
      let Just (decoded :: AsyncSearchResult Value) = decode sampleRunningResponse
      asyncSearchId decoded `shouldBe` Nothing
      asyncSearchIsRunning decoded `shouldBe` True
      asyncSearchIsPartial decoded `shouldBe` True
      asyncSearchStartTimeInMillis decoded `shouldBe` Just 1584726301000
      asyncSearchExpirationTimeInMillis decoded `shouldBe` Just 1584812701000
      asyncSearchTook decoded `shouldBe` Nothing
      asyncSearchShards decoded `shouldBe` Nothing
      asyncSearchHits decoded `shouldBe` Nothing

    it "decodes a completed response with full hits and aggregations" $ do
      let Just (decoded :: AsyncSearchResult Value) = decode sampleCompletedResponse
      unAsyncSearchId
        <$> asyncSearchId decoded
          `shouldBe` Just "FmRleEctRXJtaVNZQ1I2UkJoTDJfQkEAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3ZwAAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3Zw=="
      asyncSearchIsRunning decoded `shouldBe` False
      asyncSearchIsPartial decoded `shouldBe` False
      asyncSearchTook decoded `shouldBe` Just 5
      asyncSearchTimedOut decoded `shouldBe` Just False
      asyncSearchNumReducePhases decoded `shouldBe` Just 1
      asyncSearchShards decoded `shouldBe` Just (ShardResult 1 1 0 0)
      -- Two hits, both with the typed _source
      (fmap (length . hits) . asyncSearchHits) decoded `shouldBe` Just 2
      let sources = case asyncSearchHits decoded of
            Just sh -> [maybe Null id (hitSource h) | h <- hits sh]
            Nothing -> []
          userOf (Object o) = KM.lookup "user" o
          userOf _ = Nothing
      sort [s | Just (String s) <- userOf <$> sources] `shouldBe` ["ana", "bob"]
      asyncSearchAggregations decoded `shouldSatisfy` maybe False hasByUserKey

    it "decodes a completed response with the search payload nested under 'response' (ES8+/ES9)" $ do
      -- Elasticsearch 8.x/9.x (and modern 7.x patches) wrap the search
      -- payload under a top-level "response" object. The decode must read
      -- took/_shards/hits/aggregations from there, not the top level.
      let Just (decoded :: AsyncSearchResult Value) = decode sampleCompletedResponseNested
      unAsyncSearchId
        <$> asyncSearchId decoded
          `shouldBe` Just "FmRleEctRXJtaVNZQ1I2UkJoTDJfQkEAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3ZwAAAAAAAAAUX0Q2UkRLNEVBYlhVZ19VUUZmeld3Zw=="
      asyncSearchIsRunning decoded `shouldBe` False
      asyncSearchIsPartial decoded `shouldBe` False
      asyncSearchCompletionTimeInMillis decoded `shouldBe` Just 1584726302000
      asyncSearchTook decoded `shouldBe` Just 5
      asyncSearchTimedOut decoded `shouldBe` Just False
      asyncSearchNumReducePhases decoded `shouldBe` Just 1
      asyncSearchShards decoded `shouldBe` Just (ShardResult 1 1 0 0)
      (fmap (length . hits) . asyncSearchHits) decoded `shouldBe` Just 2
      asyncSearchAggregations decoded `shouldSatisfy` maybe False hasByUserKey

    it "decodes a nested 'response' that omits hits (partial reduce) without error" $ do
      -- While the final reduce phase has not run, the nested "response"
      -- object may carry took/_shards but no hits/aggregations. Decoding
      -- must not fail and the absent fields stay at Nothing.
      let body =
            "{\
            \  \"is_running\": false,\
            \  \"is_partial\": true,\
            \  \"response\": {\"took\": 3, \"_shards\": {\"total\": 1, \"successful\": 1, \"skipped\": 0, \"failed\": 0}}\
            \}"
          Just (decoded :: AsyncSearchResult Value) = decode body
      asyncSearchIsPartial decoded `shouldBe` True
      asyncSearchTook decoded `shouldBe` Just 3
      asyncSearchShards decoded `shouldBe` Just (ShardResult 1 1 0 0)
      asyncSearchHits decoded `shouldBe` Nothing
      asyncSearchAggregations decoded `shouldBe` Nothing

    it "reads search fields from the top level when 'response' is absent (OpenSearch shape)" $ do
      -- The flat shape (no "response" key) is what OpenSearch emits and
      -- what the legacy sampleCompletedResponse fixture documents; the
      -- dual-parse fallback must still surface those fields.
      let Just (flat :: AsyncSearchResult Value) = decode sampleCompletedResponse
          Just (nested :: AsyncSearchResult Value) = decode sampleCompletedResponseNested
      -- The two fixtures carry identical hit/aggregation data, so every
      -- search-result field must agree structurally — except
      -- completion_time_in_millis (only the nested fixture carries it).
      asyncSearchTook flat `shouldBe` asyncSearchTook nested
      asyncSearchTimedOut flat `shouldBe` asyncSearchTimedOut nested
      asyncSearchNumReducePhases flat `shouldBe` asyncSearchNumReducePhases nested
      asyncSearchShards flat `shouldBe` asyncSearchShards nested
      asyncSearchHits flat `shouldBe` asyncSearchHits nested
      asyncSearchAggregations flat `shouldBe` asyncSearchAggregations nested
      asyncSearchCompletionTimeInMillis flat `shouldBe` Nothing

    it "treats 'response': null the same as an absent 'response' (flat fallback)" $ do
      -- aeson's '.:?' collapses JSON null to Nothing, so a null response
      -- falls through to the top-level fields just like a missing key.
      let body =
            "{\
            \  \"is_running\": false,\
            \  \"is_partial\": false,\
            \  \"response\": null,\
            \  \"took\": 4,\
            \  \"_shards\": {\"total\": 1, \"successful\": 1, \"skipped\": 0, \"failed\": 0}\
            \}"
          Just (decoded :: AsyncSearchResult Value) = decode body
      asyncSearchTook decoded `shouldBe` Just 4
      asyncSearchShards decoded `shouldBe` Just (ShardResult 1 1 0 0)

    it "rejects a present-but-non-object 'response' as a contract violation" $ do
      -- Neither ES nor OpenSearch ever emits a non-object 'response'; a
      -- malformed value is surfaced as a parse failure rather than
      -- silently decoding to an all-Nothing search payload.
      let body = "{\"is_running\": false, \"response\": \"not-an-object\"}"
          decoded = decode body :: Maybe (AsyncSearchResult Value)
      decoded `shouldBe` Nothing

    it "decodes a completed status body carrying completion_time_in_millis" $ do
      let Just (decoded :: AsyncSearchStatus) =
            decode sampleCompletedStatusResponseWithCompletionTime
      asyncSearchStatusCompletionStatus decoded `shouldBe` Just 200
      asyncSearchStatusCompletionTimeInMillis decoded `shouldBe` Just 1584726302000

    it "decodes an empty {} response with the documented defaults" $ do
      -- is_running defaults to False and is_partial to True (per the
      -- AsyncSearchResult FromJSON), so {} decodes successfully and every
      -- optional field stays at Nothing.
      let Just (decoded :: AsyncSearchResult Value) = decode "{}"
      asyncSearchIsRunning decoded `shouldBe` False
      asyncSearchIsPartial decoded `shouldBe` True
      asyncSearchId decoded `shouldBe` Nothing

    it "round-trips through decode twice (deterministic parse)" $ do
      -- AsyncSearchResult is decode-only (no ToJSON, by precedent with
      -- SearchResult). Pin that two decodes of the same body agree field
      -- by field instead.
      let firstDecoded = decode sampleCompletedResponse :: Maybe (AsyncSearchResult Value)
          secondDecoded = decode sampleCompletedResponse :: Maybe (AsyncSearchResult Value)
      case (firstDecoded, secondDecoded) of
        (Just a, Just b) -> do
          a `shouldBe` b
          -- Sanity: the parsed value is actually non-trivial.
          asyncSearchTook a `shouldBe` Just 5
        _ -> expectationFailure "decode returned Nothing"

    it "tolerates unknown extra fields in the body" $ do
      -- The wire shape will grow new fields over time; decode must not
      -- reject bodies just because ES added a key we don't model yet.
      let Just (decoded :: AsyncSearchResult Value) =
            decode "{ \"is_running\": true, \"future_field\": \"whatever\" }"
      asyncSearchIsRunning decoded `shouldBe` True

-- | True iff the given aggregations map contains a @by_user@ key.
hasByUserKey :: AggregationResults -> Bool
hasByUserKey results = M.member "by_user" results