EsQueryViewsSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.EsQueryViewsSpec (spec) where

import Data.Aeson
import Data.Aeson.Key (Key)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Maybe (isJust, isNothing)
import Data.Text qualified as T
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.ElasticSearch8.Types qualified as ES8Types
import Database.Bloodhound.ElasticSearch9.Client qualified as ClientES9
import Database.Bloodhound.ElasticSearch9.Requests qualified as RequestsES9
import Database.Bloodhound.ElasticSearch9.Types qualified as ES9Types
import TestsUtils.Common
import TestsUtils.Import

hasKey :: Key -> LBS.ByteString -> Bool
hasKey k bs = case decode bs of
  Just (Object obj) -> k `KM.member` obj
  _ -> False

spec :: Spec
spec = describe "ES|QL Views and running-query APIs" $ do
  describe "ESQLViewName JSON" $ do
    it "round-trips as a bare JSON string" $ do
      let n = ES9Types.ESQLViewName "my-view"
      decode (encode n) `shouldBe` Just n
      encode n `shouldBe` "\"my-view\""

    it "supports IsString literal syntax" $ do
      let n = ("literal" :: ES9Types.ESQLViewName)
      ES9Types.unESQLViewName n `shouldBe` "literal"

  describe "ESQLView JSON" $ do
    it "encodes a minimal view (name + query required)" $ do
      let v =
            ES9Types.ESQLView
              { esqlViewName = "logs-view",
                esqlViewQuery = "FROM logs | KEEP @timestamp, message | LIMIT 10"
              }
      let json = encode v
      json `shouldSatisfy` hasKey "name"
      json `shouldSatisfy` hasKey "query"

    it "decodes the wire shape returned by GET /_query/view/{name}" $ do
      let raw =
            LBS.pack
              "{\"name\":\"logs-view\",\"query\":\"FROM logs | LIMIT 10\"}"
      let expected =
            ES9Types.ESQLView
              { esqlViewName = "logs-view",
                esqlViewQuery = "FROM logs | LIMIT 10"
              }
      decode raw `shouldBe` Just expected

    it "decodes the {\"views\":[...]} envelope returned by ES 9.4+" $ do
      -- GET /_query/view/{name} on ES 9.4 wraps the single view in a
      -- `views` array. The parser must unwrap it transparently.
      let raw =
            LBS.pack
              "{\"views\":[{\"name\":\"logs-view\",\"query\":\"FROM logs | LIMIT 10\"}]}"
      let expected =
            ES9Types.ESQLView
              { esqlViewName = "logs-view",
                esqlViewQuery = "FROM logs | LIMIT 10"
              }
      decode raw `shouldBe` Just expected

    it "rejects an empty {\"views\":[]} envelope" $ do
      let raw = LBS.pack "{\"views\":[]}"
      decode raw `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLView -> Bool)

    it "round-trips through ToJSON/FromJSON" $ do
      let v =
            ES9Types.ESQLView
              { esqlViewName = "v",
                esqlViewQuery = "ROW x = 1"
              }
      decode (encode v) `shouldBe` Just v

    it "rejects a payload missing the required query field" $ do
      let raw = LBS.pack "{\"name\":\"v\"}"
      decode raw `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLView -> Bool)

    it "rejects a payload missing the required name field" $ do
      let raw = LBS.pack "{\"query\":\"ROW x = 1\"}"
      decode raw `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLView -> Bool)

    it "rejects malformed input (non-object)" $
      decode (LBS.pack "[1,2,3]") `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLView -> Bool)

  describe "ESQLQueryInfo JSON" $ do
    -- The OpenAPI spec lists id/node/coordinating_node/data_nodes as
    -- required, but ES 9.3 GA omits them on single-node clusters. The
    -- decoder must therefore tolerate their absence. The fields ES 9.3
    -- actually emits on this endpoint are start_time_millis,
    -- running_time_nanos and query (the documents_found/values_loaded
    -- counters belong to the AsyncESQLResult shape, not this one).
    let observedShapeRaw =
          LBS.pack
            "{\"start_time_millis\":1782072118262,\"running_time_nanos\":1032189,\"query\":\"ROW x = 1\"}"
        observedShapeExpected =
          ES9Types.ESQLQueryInfo
            { esqlQueryInfoId = Nothing,
              esqlQueryInfoNode = Nothing,
              esqlQueryInfoStartTimeMillis = Just 1782072118262,
              esqlQueryInfoRunningTimeNanos = Just 1032189,
              esqlQueryInfoQuery = "ROW x = 1",
              esqlQueryInfoCoordinatingNode = Nothing,
              esqlQueryInfoDataNodes = Nothing
            }
        -- The shape the OpenAPI spec promises — multi-node clusters or
        -- future ES versions may emit it. The decoder must accept every
        -- documented field.
        fullSpecRaw =
          LBS.pack
            "{\"id\":223601,\"node\":\"node-1\",\"start_time_millis\":1782071481880,\"running_time_nanos\":1500000,\"query\":\"FROM logs | LIMIT 10\",\"coordinating_node\":\"coord-1\",\"data_nodes\":[\"data-1\",\"data-2\"]}"
        fullSpecExpected =
          ES9Types.ESQLQueryInfo
            { esqlQueryInfoId = Just 223601,
              esqlQueryInfoNode = Just "node-1",
              esqlQueryInfoStartTimeMillis = Just 1782071481880,
              esqlQueryInfoRunningTimeNanos = Just 1500000,
              esqlQueryInfoQuery = "FROM logs | LIMIT 10",
              esqlQueryInfoCoordinatingNode = Just "coord-1",
              esqlQueryInfoDataNodes = Just ["data-1", "data-2"]
            }

    it "decodes the wire shape observed on an ES 9.3 single-node cluster" $
      decode observedShapeRaw `shouldBe` Just observedShapeExpected

    it "decodes the full shape documented in the OpenAPI spec" $
      decode fullSpecRaw `shouldBe` Just fullSpecExpected

    it "exposes every field through its lens on the observed shape" $ do
      let Just parsed = decode observedShapeRaw
      ES9Types.esqlQueryInfoId parsed `shouldSatisfy` isNothing
      ES9Types.esqlQueryInfoNode parsed `shouldSatisfy` isNothing
      ES9Types.esqlQueryInfoStartTimeMillis parsed `shouldBe` Just 1782072118262
      ES9Types.esqlQueryInfoRunningTimeNanos parsed `shouldBe` Just 1032189
      ES9Types.esqlQueryInfoQuery parsed `shouldBe` "ROW x = 1"
      ES9Types.esqlQueryInfoCoordinatingNode parsed `shouldSatisfy` isNothing
      ES9Types.esqlQueryInfoDataNodes parsed `shouldSatisfy` isNothing

    it "exposes every field through its lens on the spec shape" $ do
      let Just parsed = decode fullSpecRaw
      ES9Types.esqlQueryInfoId parsed `shouldBe` Just 223601
      ES9Types.esqlQueryInfoNode parsed `shouldBe` Just "node-1"
      ES9Types.esqlQueryInfoCoordinatingNode parsed `shouldBe` Just "coord-1"
      ES9Types.esqlQueryInfoDataNodes parsed `shouldBe` Just ["data-1", "data-2"]

    it "rejects a payload missing the required query field" $
      let malformed = LBS.pack "{\"id\":1,\"node\":\"n\"}"
       in decode malformed `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLQueryInfo -> Bool)

    it "rejects malformed input (non-object)" $
      decode (LBS.pack "42") `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLQueryInfo -> Bool)

  describe "ESQLQueryListResponse JSON" $ do
    -- The live endpoint returns {"queries": {"<encoded-async-id>": {...}}}
    -- — an object keyed by async-id, NOT a bare array. The decoder
    -- flattens it into [(AsyncESQLId, ESQLQueryInfo)] so callers keep the
    -- id they need to act on a listed query.
    let observedInfo =
          ES9Types.ESQLQueryInfo
            { esqlQueryInfoId = Nothing,
              esqlQueryInfoNode = Nothing,
              esqlQueryInfoStartTimeMillis = Just 1782072118262,
              esqlQueryInfoRunningTimeNanos = Just 1032189,
              esqlQueryInfoQuery = "ROW x = 1",
              esqlQueryInfoCoordinatingNode = Nothing,
              esqlQueryInfoDataNodes = Nothing
            }
        specInfo =
          ES9Types.ESQLQueryInfo
            { esqlQueryInfoId = Just 223601,
              esqlQueryInfoNode = Just "node-1",
              esqlQueryInfoStartTimeMillis = Just 1782071481880,
              esqlQueryInfoRunningTimeNanos = Just 1500000,
              esqlQueryInfoQuery = "FROM logs | LIMIT 10",
              esqlQueryInfoCoordinatingNode = Just "coord-1",
              esqlQueryInfoDataNodes = Just ["data-1", "data-2"]
            }
        observedJson =
          "{\"start_time_millis\":1782072118262,\"running_time_nanos\":1032189,\"query\":\"ROW x = 1\"}"
        specJson =
          "{\"id\":223601,\"node\":\"node-1\",\"start_time_millis\":1782071481880,\"running_time_nanos\":1500000,\"query\":\"FROM logs | LIMIT 10\",\"coordinating_node\":\"coord-1\",\"data_nodes\":[\"data-1\",\"data-2\"]}"
        liveAsyncId = "FmpYLUxnNVZyVE5pZ0gzNXZOdXpHYUEdZGhxczRoSWpUSWU5WEJrQ2ZaTzM0dzoxMjg1Nzc="
    it "decodes the live {\"queries\":{id:{...}}} keyed-map shape" $
      let raw = LBS.pack $ "{\"queries\":{\"" <> liveAsyncId <> "\":" <> observedJson <> "}}"
       in fmap ES9Types.unESQLQueryListResponse (decode raw)
            `shouldBe` Just [(ES8Types.AsyncESQLId (T.pack liveAsyncId), observedInfo)]

    it "decodes a bare keyed map (no queries wrapper)" $
      let raw = LBS.pack $ "{\"query-1\":" <> specJson <> "}"
       in fmap ES9Types.unESQLQueryListResponse (decode raw)
            `shouldBe` Just [(ES8Types.AsyncESQLId "query-1", specInfo)]

    it "decodes multiple entries under queries" $
      let raw =
            LBS.pack $
              "{\"queries\":{\"a\":" <> observedJson <> ",\"b\":" <> specJson <> "}}"
       in fmap ES9Types.unESQLQueryListResponse (decode raw)
            `shouldBe` Just [(ES8Types.AsyncESQLId "a", observedInfo), (ES8Types.AsyncESQLId "b", specInfo)]

    it "decodes an empty queries object as []" $
      fmap ES9Types.unESQLQueryListResponse (decode (LBS.pack "{\"queries\":{}}")) `shouldBe` Just []

    it "rejects a {\"queries\":[...]} array value" $
      let raw = LBS.pack "{\"queries\":[{\"query\":\"x\"}]}"
       in decode raw `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLQueryListResponse -> Bool)

    it "rejects a non-object top-level payload" $
      decode (LBS.pack "\"just a string\"")
        `shouldSatisfy` (isNothing :: Maybe ES9Types.ESQLQueryListResponse -> Bool)

  describe "endpoint shape" $ do
    -- These endpoints (ES 9.4+ views, ES 9.1+ running-query introspection)
    -- do not exist on Elasticsearch 8.x, so the canonical request builders
    -- live only in "Database.Bloodhound.ElasticSearch9.Requests". The
    -- endpoint/path assertions below guard against any future drift.
    it "putESQLView PUTs to /_query/view/{name} with a query body (ES9)" $ do
      let req = RequestsES9.putESQLView "my-view" "FROM logs | LIMIT 10"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query", "view", "my-view"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      let Just bodyBytes = bhRequestBody req
      hasKey "query" bodyBytes `shouldBe` True
      -- Body must NOT carry a "name" field — name comes from the path.
      hasKey "name" bodyBytes `shouldBe` False

    it "getESQLView GETs /_query/view/{name} with no body (ES9)" $ do
      let req = RequestsES9.getESQLView "my-view"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query", "view", "my-view"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldSatisfy` isNothing

    it "deleteESQLView DELETEs /_query/view/{name} with no body (ES9)" $ do
      let req = RequestsES9.deleteESQLView "my-view"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query", "view", "my-view"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldSatisfy` isNothing

    it "getESQLQuery GETs /_query/queries/{id} with no body (ES9)" $ do
      let req = RequestsES9.getESQLQuery (ES8Types.AsyncESQLId "Fm_==_RxD_123")
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query", "queries", "Fm_==_RxD_123"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldSatisfy` isNothing

    it "getESQLQueries GETs /_query/queries with no body (ES9)" $ do
      let req = RequestsES9.getESQLQueries
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_query", "queries"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldSatisfy` isNothing

  describe "live integration (requires ES9.4+ for views; ES9.1+ for queries)" $ do
    -- ES|QL views are experimental, added in 9.4.0. The current
    -- docker-compose ships ES 9.3.0, where PUT/GET/DELETE /_query/view
    -- return HTTP 400 "no handler found". These tests therefore
    -- `pendingWith` out on backends that lack the endpoints, but
    -- remain structurally valid against a 9.4+ cluster.
    backendSpecific [ElasticSearch9] $ do
      it "round-trips an ES|QL view via PUT then GET then DELETE" $
        withTestEnv $ do
          let viewName = ES9Types.ESQLViewName "bloodhound-test-esql-view"
          -- Clean up any pre-existing view from a prior run.
          _ <- tryEsError $ ClientES9.deleteESQLView viewName
          putResp <- tryEsError $ ClientES9.putESQLView viewName "FROM logs | LIMIT 10"
          case putResp of
            Left e
              | endpointMissing e ->
                  liftIO $ pendingWith "ES|QL views require Elasticsearch 9.4+"
              | otherwise ->
                  liftIO $ expectationFailure $ "putESQLView failed: " <> show e
            Right _ -> do
              getResp <- tryEsError $ ClientES9.getESQLView viewName
              liftIO $
                case getResp of
                  Left e -> expectationFailure $ "getESQLView failed: " <> show e
                  Right v -> do
                    ES9Types.esqlViewName v `shouldBe` ES9Types.unESQLViewName viewName
                    ES9Types.esqlViewQuery v `shouldBe` "FROM logs | LIMIT 10"
              delResp <- tryEsError $ ClientES9.deleteESQLView viewName
              liftIO $
                case delResp of
                  Left e -> expectationFailure $ "deleteESQLView failed: " <> show e
                  Right _ -> pure ()

      it "fetches information about a running ES|QL query" $
        withTestEnv $ do
          -- Submit a long-running async query, then poll /_query/queries/{id}.
          let base =
                ES9Types.ESQLRequest
                  { esqlQuery = "ROW x = 1",
                    esqlLocale = Nothing,
                    esqlTimeZone = Nothing,
                    esqlFilter = Nothing,
                    esqlParams = Nothing,
                    esqlColumnar = Nothing,
                    esqlProfile = Nothing,
                    esqlTables = Nothing,
                    esqlIncludeCcsMetadata = Nothing,
                    esqlIncludeExecutionMetadata = Nothing
                  }
              areq =
                (ES9Types.mkAsyncESQLRequest base)
                  { ES9Types.asyncESQLRequestWaitForCompletionTimeout = Just "0ms",
                    ES9Types.asyncESQLRequestKeepAlive = Just "5m"
                  }
          submitted <- ClientES9.esqlAsync areq
          case submitted of
            Left e
              | queryNotRunning e ->
                  liftIO $ pendingWith "Query completed before we could introspect it"
              | otherwise ->
                  liftIO $ expectationFailure $ "esqlAsync failed: " <> show e
            Right r -> case ES8Types.asyncESQLResultId r of
              Nothing -> liftIO $ pendingWith "Async submission did not return an id to poll"
              Just aid -> do
                infoResp <- tryEsError $ ClientES9.getESQLQuery aid
                case infoResp of
                  Left e
                    | queryNotRunning e ->
                        liftIO $ pendingWith "Query completed before we could introspect it"
                    | otherwise ->
                        liftIO $ expectationFailure $ "getESQLQuery failed: " <> show e
                  Right info -> liftIO $ do
                    ES9Types.esqlQueryInfoQuery info `shouldBe` "ROW x = 1"
                    ES9Types.esqlQueryInfoStartTimeMillis info `shouldSatisfy` isJust
                    ES9Types.esqlQueryInfoRunningTimeNanos info `shouldSatisfy` isJust
                -- Clean up.
                void $ tryEsError $ ClientES9.deleteAsyncESQL aid

      it "lists a running ES|QL query via GET /_query/queries" $
        withTestEnv $ do
          -- Submit a long-running async query, then list /_query/queries
          -- and confirm the submitted query is among the running ones.
          let base =
                ES9Types.ESQLRequest
                  { esqlQuery = "ROW x = 1",
                    esqlLocale = Nothing,
                    esqlTimeZone = Nothing,
                    esqlFilter = Nothing,
                    esqlParams = Nothing,
                    esqlColumnar = Nothing,
                    esqlProfile = Nothing,
                    esqlTables = Nothing,
                    esqlIncludeCcsMetadata = Nothing,
                    esqlIncludeExecutionMetadata = Nothing
                  }
              areq =
                (ES9Types.mkAsyncESQLRequest base)
                  { ES9Types.asyncESQLRequestWaitForCompletionTimeout = Just "0ms",
                    ES9Types.asyncESQLRequestKeepAlive = Just "5m"
                  }
          submitted <- ClientES9.esqlAsync areq
          case submitted of
            Left e
              | queryNotRunning e ->
                  liftIO $ pendingWith "Query completed before we could introspect it"
              | otherwise ->
                  liftIO $ expectationFailure $ "esqlAsync failed: " <> show e
            Right r -> case ES8Types.asyncESQLResultId r of
              Nothing -> liftIO $ pendingWith "Async submission did not return an id to poll"
              Just aid -> do
                listResp <- tryEsError $ ClientES9.getESQLQueries
                case listResp of
                  Left e ->
                    liftIO $ expectationFailure $ "getESQLQueries failed: " <> show e
                  Right infos ->
                    liftIO $
                      if any (("ROW x = 1" ==) . ES9Types.esqlQueryInfoQuery . snd) infos
                        then pure ()
                        else
                          pendingWith
                            "Submitted query completed before appearing in GET /_query/queries"
                -- Clean up.
                void $ tryEsError $ ClientES9.deleteAsyncESQL aid

-- | Detect the @no handler found for uri@shape returned by Elasticsearch
-- when an endpoint isn't registered on this version (e.g. ES|QL views
-- on 9.3.0). Used to mark the live view tests as 'pendingWith' rather
-- than failing.
endpointMissing :: EsError -> Bool
endpointMissing e =
  "no handler found" `T.isInfixOf` T.toLower (errorMessage e)

-- | Detect the @task isn't running@shape returned by
-- @GET /_query/queries/{id}@ when the queried async query has already
-- completed and been purged from the running-queries registry. Common
-- for sub-second queries; the test treats this as a soft skip.
queryNotRunning :: EsError -> Bool
queryNotRunning e =
  let msg = T.toLower (errorMessage e)
   in "isn't running" `T.isInfixOf` msg || "not running" `T.isInfixOf` msg