ConnectorsSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Test.ConnectorsSpec (spec) where

import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List (sort)
import Data.Text qualified as T
import Database.Bloodhound.Client.Cluster (BackendType (..))
import Database.Bloodhound.ElasticSearch8.Client qualified as ClientES8
import Database.Bloodhound.ElasticSearch8.Requests qualified as RequestsES8
import Database.Bloodhound.ElasticSearch8.Types qualified as Types
import TestsUtils.Common
import TestsUtils.Import

normalize :: [(Text, Maybe Text)] -> [(Text, Maybe Text)]
normalize = sort

spec :: Spec
spec =
  describe "Connectors API (/_connector*)" $ do
    describe "ConnectorId / ConnectorSyncJobId JSON" $ do
      it "round-trips a ConnectorId as a bare string" $
        decode (encode (Types.ConnectorId "my-conn" :: Types.ConnectorId))
          `shouldBe` Just (Types.ConnectorId "my-conn")
      it "round-trips a ConnectorSyncJobId" $
        decode (encode (Types.ConnectorSyncJobId "job-1"))
          `shouldBe` Just (Types.ConnectorSyncJobId "job-1")

    describe "Connector (GET entity) decoding" $ do
      it "decodes the typed scalar fields and parks the rest in extras" $ do
        let raw =
              LBS.pack
                "{\"id\":\"c1\",\"name\":\"wiki\",\"index_name\":\"wiki-index\",\
                \\"is_native\":false,\"service_type\":\"sharepoint\",\"status\":\"configured\",\
                \\"configuration\":{\"foo\":\"bar\"},\"last_seen\":\"2024-01-01\"}"
        case decode raw :: Maybe Types.Connector of
          Just c -> do
            Types.cId c `shouldBe` Just "c1"
            Types.cName c `shouldBe` Just "wiki"
            Types.cIndexName c `shouldBe` Just "wiki-index"
            Types.cIsNative c `shouldBe` Just False
            Types.cServiceType c `shouldBe` Just "sharepoint"
            Types.cStatus c `shouldBe` Just "configured"
            -- extras carries configuration + last_seen
            case Types.cExtras c of
              Just _ -> pure ()
              Nothing -> expectationFailure "extras should retain untyped fields"
          Nothing -> expectationFailure "failed to decode Connector"
      it "round-trips a Connector (typed fields survive, extras merge)" $ do
        let c =
              Types.Connector
                { Types.cId = Just "c1",
                  Types.cName = Just "wiki",
                  Types.cDescription = Nothing,
                  Types.cIndexName = Just "wiki-index",
                  Types.cIsNative = Just False,
                  Types.cLanguage = Nothing,
                  Types.cServiceType = Just "sharepoint",
                  Types.cStatus = Just "configured",
                  Types.cError = Nothing,
                  Types.cApiKeyId = Nothing,
                  Types.cApiKeySecretId = Nothing,
                  Types.cSyncNow = Nothing,
                  Types.cExtras = Nothing
                }
        decode (encode c) `shouldBe` Just c

    describe "envelope responses" $ do
      it "ConnectorMutationResult decodes {result}" $
        decode "{\"result\":\"created\"}"
          `shouldBe` Just (Types.ConnectorMutationResult (Just "created"))
      it "ConnectorCreateResponse decodes {result, id}" $
        decode "{\"result\":\"created\",\"id\":\"abc\"}"
          `shouldBe` Just
            ( Types.ConnectorCreateResponse
                { Types.ccrResult = Just "created",
                  Types.ccrId = Just "abc"
                }
            )
      it "ConnectorSyncJobCreateResponse decodes bare {id} (no result)" $
        decode "{\"id\":\"job-7\"}"
          `shouldBe` Just
            (Types.ConnectorSyncJobCreateResponse {Types.sjcrId = Just "job-7"})
      it "ConnectorListResponse decodes {count, results}" $ do
        let raw =
              LBS.pack
                "{\"count\":1,\"results\":[{\"id\":\"c1\",\"name\":\"wiki\"}]}"
        case decode raw :: Maybe Types.ConnectorListResponse of
          Just resp -> do
            Types.clrCount resp `shouldBe` Just 1
            length (Types.clrResults resp) `shouldBe` 1
          Nothing -> expectationFailure "failed to decode ConnectorListResponse"

    describe "connectorListOptionsParams URI rendering" $ do
      it "default emits no params" $
        Types.connectorListOptionsParams Types.defaultConnectorListOptions
          `shouldBe` []
      it "renders from/size and the filters" $ do
        let opts =
              Types.defaultConnectorListOptions
                { Types.cloFrom = Just 0,
                  Types.cloSize = Just 25,
                  Types.cloServiceType = Just "sharepoint",
                  Types.cloQuery = Just "wiki"
                }
        normalize (Types.connectorListOptionsParams opts)
          `shouldBe` sort
            [ ("from", Just "0"),
              ("size", Just "25"),
              ("service_type", Just "sharepoint"),
              ("q", Just "wiki")
            ]

    describe "CreateConnectorRequest JSON" $ do
      it "omits Nothing fields" $ do
        let req =
              Types.defaultCreateConnectorRequest
                { Types.ccrName = Just "wiki",
                  Types.ccrIndexName = Just "wiki-index",
                  Types.ccrServiceType = Just "sharepoint"
                }
        encode req
          `shouldBe` "{\"index_name\":\"wiki-index\",\"name\":\"wiki\",\"service_type\":\"sharepoint\"}"
        decode (encode req) `shouldBe` Just req

    describe "endpoint shape (core CRUD)" $ do
      it "POSTs /_connector with a JSON body" $ do
        let req =
              RequestsES8.createConnector
                Types.defaultCreateConnectorRequest
                  { Types.ccrName = Just "wiki"
                  }
        getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_connector"]
        bhRequestBody req `shouldSatisfy` isJust
      it "PUTs /_connector/<id> with a body" $ do
        let req =
              RequestsES8.putConnector
                "c1"
                Types.defaultCreateConnectorRequest
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1"]
        bhRequestBody req `shouldSatisfy` isJust
      it "GETs /_connector/<id> with no body" $ do
        let req = RequestsES8.getConnector "c1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1"]
        bhRequestBody req `shouldSatisfy` isNothing
      it "DELETEs /_connector/<id> (no params by default)" $ do
        let req = RequestsES8.deleteConnector "c1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1"]
        getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      it "deleteConnectorWith appends delete_sync_jobs" $ do
        let req = RequestsES8.deleteConnectorWith (Just True) "c1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1"]
        getRawEndpointQueries (bhRequestEndpoint req)
          `shouldBe` [("delete_sync_jobs", Just "true")]
      it "listConnectorsWith appends query params" $ do
        let req =
              RequestsES8.listConnectorsWith
                Types.defaultConnectorListOptions {Types.cloSize = Just 10}
        getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_connector"]
        getRawEndpointQueries (bhRequestEndpoint req)
          `shouldBe` [("size", Just "10")]

    describe "endpoint shape (connector actions)" $ do
      it "PUTs /_connector/<id>/_check_in with empty body" $ do
        let req = RequestsES8.checkInConnector "c1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1", "_check_in"]
        bhRequestBody req `shouldSatisfy` isJust
      it "PUTs /_connector/<id>/_filtering/_validation" $ do
        let req =
              RequestsES8.updateConnectorDraftFilteringValidation
                "c1"
                (Types.UpdateConnectorFilteringValidationRequest Nothing)
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1", "_filtering", "_validation"]
      it "PUTs /_connector/<id>/_filtering/_activate (no body)" $ do
        let req = RequestsES8.activateConnectorDraftFiltering "c1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "c1", "_filtering", "_activate"]
        bhRequestBody req `shouldSatisfy` isJust

    describe "endpoint shape (sync jobs)" $ do
      it "POSTs /_connector/_sync_job with a body" $ do
        let req =
              RequestsES8.createConnectorSyncJob
                ( Types.CreateConnectorSyncJobRequest
                    { Types.csjrId = Just "c1",
                      Types.csjrJobType = Just "full",
                      Types.csjrTriggerMethod = Just "on_demand"
                    }
                )
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "_sync_job"]
        bhRequestBody req `shouldSatisfy` isJust
      it "GETs /_connector/_sync_job/<id>" $ do
        let req = RequestsES8.getConnectorSyncJob "job-1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "_sync_job", "job-1"]
        bhRequestBody req `shouldSatisfy` isNothing
      it "DELETEs /_connector/_sync_job/<id>" $ do
        let req = RequestsES8.deleteConnectorSyncJob "job-1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "_sync_job", "job-1"]
      it "PUTs /_connector/_sync_job/<id>/_cancel" $ do
        let req = RequestsES8.cancelConnectorSyncJob "job-1"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "_sync_job", "job-1", "_cancel"]
      it "PUTs /_connector/_sync_job/<id>/_claim with a body" $ do
        let req =
              RequestsES8.claimConnectorSyncJob
                "job-1"
                (Types.ClaimConnectorSyncJobRequest Nothing Nothing)
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_connector", "_sync_job", "job-1", "_claim"]
        bhRequestBody req `shouldSatisfy` isJust

    describe "live integration (requires ES8+ backend)" $
      backendSpecific [ElasticSearch8] $ do
        it "round-trips a connector via POST then GET then DELETE" $
          withTestEnv $ do
            let cid = Types.ConnectorId "bloodhound-test-connector"
                body =
                  Types.defaultCreateConnectorRequest
                    { Types.ccrName = Just "bloodhound-test-connector",
                      Types.ccrIndexName = Just "bloodhound-test-connector",
                      Types.ccrServiceType = Just "sharepoint"
                    }
            _ <- tryPerformBHRequest $ RequestsES8.deleteConnector cid
            createResp <- tryEsError (ClientES8.createConnector body)
            case createResp of
              Left e
                | errorStatus e == Just 403 ->
                    liftIO $
                      pendingWith
                        "connectors API requires the edit_connectors \
                        \cluster privilege; skip on locked-down clusters"
                | "privilege" `T.isInfixOf` T.toLower (errorMessage e) ->
                    liftIO $
                      pendingWith
                        "connectors API rejected the request for missing \
                        \privilege on this cluster"
                | errorStatus e == Just 404 ->
                    liftIO $
                      pendingWith
                        "connectors API returned 404 on POST /_connector; \
                        \feature not provisioned on this cluster"
                | "not found" `T.isInfixOf` T.toLower (errorMessage e) ->
                    liftIO $
                      pendingWith
                        "connectors API reported 'not found' on create; \
                        \endpoint unavailable on this cluster"
              Left e ->
                liftIO $
                  expectationFailure ("unexpected POST error: " <> show e)
              Right resp -> do
                -- The ES Connectors API auto-generates the connector _id
                -- on POST; the @name@ / @index_name@ we send in the body
                -- are *not* the id. Prefer the id the server returned in
                -- 'ConnectorCreateResponse' and only fall back to the
                -- caller-supplied @cid@ if the server omitted it.
                let lookupId = fromMaybe cid (Types.ccrId resp)
                fetched <- tryPerformBHRequest $ RequestsES8.getConnector lookupId
                case fetched of
                  Right c -> liftIO $ Types.cName c `shouldBe` Just "bloodhound-test-connector"
                  Left _ -> liftIO $ pure ()
                -- Best-effort cleanup: a 404 here (e.g. the connector was
                -- already reaped by a prior run, or the server returned no
                -- id and the fallback cid does not match) must not fail
                -- the test.
                _ <- tryEsError (ClientES8.deleteConnector lookupId)
                pure ()