SearchableSnapshotsSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Test.SearchableSnapshotsSpec (spec) where

import Data.Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Database.Bloodhound.Common.Requests qualified as Common
import TestsUtils.Import
import Prelude

-- | A representative mount request body carrying the required @index@
-- plus the three documented optional fields.
sampleMountBodyBytes :: LBS.ByteString
sampleMountBodyBytes =
  "{\
  \  \"index\": \"fs\",\
  \  \"renamed_index\": \"fs-mounted\",\
  \  \"index_settings\": {\"index.number_of_replicas\": 0},\
  \  \"ignore_index_settings\": [\"index.refresh_interval\"]\
  \}"

spec :: Spec
spec = describe "Searchable Snapshots API" $ do
  describe "SearchableSnapshotMount JSON (POST body)" $ do
    it "decodes the documented fields" $ do
      let Just decoded = decode sampleMountBodyBytes :: Maybe SearchableSnapshotMount
      unIndexName (ssmIndex decoded) `shouldBe` "fs"
      ssmRenamedIndex decoded `shouldBe` Just "fs-mounted"
      ssmIgnoreIndexSettings decoded `shouldBe` Just ["index.refresh_interval"]

    it "requires the 'index' field" $ do
      let decoded = decode "{\"renamed_index\": \"x\"}" :: Maybe SearchableSnapshotMount
      decoded `shouldBe` Nothing

    it "tolerates missing optional fields" $ do
      let Just decoded = decode "{\"index\": \"only\"}" :: Maybe SearchableSnapshotMount
      unIndexName (ssmIndex decoded) `shouldBe` "only"
      ssmRenamedIndex decoded `shouldBe` Nothing
      ssmIgnoreIndexSettings decoded `shouldBe` Nothing
      ssmExtras decoded `shouldBe` KM.empty

    it "preserves unknown sibling fields in extras (forward-compatible)" $ do
      let bytes = encode (object ["index" .= String "idx", "future_field" .= (3 :: Int)])
          Just decoded = decode bytes :: Maybe SearchableSnapshotMount
      unIndexName (ssmIndex decoded) `shouldBe` "idx"
      KM.toList (ssmExtras decoded) `shouldSatisfy` any ((== "future_field") . fst)
      -- full round-trip must survive (extras carry through encode too)
      (decode . encode) decoded `shouldBe` Just decoded

    it "round-trips through ToJSON/FromJSON" $ do
      let Just decoded = decode sampleMountBodyBytes :: Maybe SearchableSnapshotMount
      (decode . encode) decoded `shouldBe` Just decoded

  describe "SearchableSnapshotStorage JSON" $ do
    it "round-trips the documented storage modes" $ do
      encode SearchableSnapshotStorageSharedPartialCache
        `shouldBe` "\"shared_partial_cache\""
      encode SearchableSnapshotStorageSharedCache
        `shouldBe` "\"shared_cache\""
      decode "\"shared_partial_cache\""
        `shouldBe` Just SearchableSnapshotStorageSharedPartialCache
      decode "\"shared_cache\""
        `shouldBe` Just SearchableSnapshotStorageSharedCache

    it "absorbs an unknown value into the custom branch" $ do
      let Just decoded = decode "\"future_mode\"" :: Maybe SearchableSnapshotStorage
      decoded `shouldBe` SearchableSnapshotStorageCustom "future_mode"

  describe "SearchableSnapshotMountOptions params" $ do
    it "default options render no query string" $ do
      searchableSnapshotMountOptionsParams defaultSearchableSnapshotMountOptions
        `shouldBe` []

    it "renders all three parameters when set" $ do
      let opts =
            defaultSearchableSnapshotMountOptions
              { ssmoMasterTimeout = Just "30s",
                ssmoWaitForCompletion = Just False,
                ssmoStorage = Just SearchableSnapshotStorageSharedCache
              }
      searchableSnapshotMountOptionsParams opts
        `shouldMatchList` [ ("master_timeout", Just "30s"),
                            ("wait_for_completion", Just "false"),
                            ("storage", Just "shared_cache")
                          ]

    it "omits Nothing fields" $ do
      let opts = defaultSearchableSnapshotMountOptions {ssmoWaitForCompletion = Just True}
      searchableSnapshotMountOptionsParams opts
        `shouldBe` [("wait_for_completion", Just "true")]

  describe "SearchableSnapshotMountResponse JSON" $ do
    it "decodes the wait_for_completion=true shape (snapshot object)" $ do
      let bytes = encode (object ["snapshot" .= object ["snapshot" .= String "snap-1"]])
          Just decoded = decode bytes :: Maybe SearchableSnapshotMountResponse
      ssmrSnapshot decoded `shouldSatisfy` isJust

    it "captures the wait_for_completion=false ack shape in extras" $ do
      let bytes =
            encode
              ( object
                  [ "acknowledged" .= True,
                    "shards_acknowledged" .= True
                  ]
              )
          Just decoded = decode bytes :: Maybe SearchableSnapshotMountResponse
      ssmrSnapshot decoded `shouldBe` Nothing
      KM.toList (ssmrExtras decoded)
        `shouldSatisfy` any ((== "acknowledged") . fst)

    it "round-trips through ToJSON/FromJSON" $ do
      let resp =
            SearchableSnapshotMountResponse
              { ssmrSnapshot = Just (object ["snapshot" .= String "s"]),
                ssmrExtras = KM.empty
              }
      (decode . encode) resp `shouldBe` Just resp

  describe "SearchableSnapshotsStatsResponse JSON" $ do
    it "decodes total/indices and tolerates absent nodes" $ do
      let bytes =
            encode
              ( object
                  [ "total" .= object ["file_cache_size" .= (1024 :: Int)],
                    "indices" .= object ["fs" .= object ["local" .= object []]]
                  ]
              )
          Just decoded = decode bytes :: Maybe SearchableSnapshotsStatsResponse
      sssrTotal decoded `shouldSatisfy` isJust
      sssrIndices decoded `shouldSatisfy` isJust
      sssrNodes decoded `shouldBe` Nothing

    it "round-trips through ToJSON/FromJSON" $ do
      let resp =
            SearchableSnapshotsStatsResponse
              { sssrTotal = Just (object []),
                sssrIndices = Just (KM.singleton "fs" (object [])),
                sssrNodes = Nothing,
                sssrExtras = KM.empty
              }
      (decode . encode) resp `shouldBe` Just resp

    it "preserves extras carrying null/empty-array values (forward-compat)" $ do
      -- omitNulls would silently drop these; 'object' must keep them.
      let resp =
            SearchableSnapshotsStatsResponse
              { sssrTotal = Nothing,
                sssrIndices = Nothing,
                sssrNodes = Nothing,
                sssrExtras =
                  KM.fromList
                    [ ("deprecated_field", Null),
                      ("empty_warnings", Array mempty)
                    ]
              }
      (decode . encode) resp `shouldBe` Just resp

  describe "SearchableSnapshotsCacheStatsResponse JSON" $ do
    it "decodes the indices map" $ do
      let bytes = encode (object ["indices" .= object ["fs" .= object []]])
          Just decoded = decode bytes :: Maybe SearchableSnapshotsCacheStatsResponse
      sscsrIndices decoded `shouldSatisfy` isJust

    it "round-trips through ToJSON/FromJSON" $ do
      let resp =
            SearchableSnapshotsCacheStatsResponse
              { sscsrIndices = Just (KM.singleton "fs" (object [])),
                sscsrExtras = KM.empty
              }
      (decode . encode) resp `shouldBe` Just resp

  describe "mountSearchableSnapshot endpoint shape" $ do
    let body = defaultSearchableSnapshotMount [qqIndexName|fs|]
        req = Common.mountSearchableSnapshot (SnapshotRepoName "my-repo") (SnapshotName "snap-1") body

    it "POSTs /_snapshot/{repo}/{snapshot}/_mount" $ do
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_snapshot", "my-repo", "snap-1", "_mount"]

    it "uses the POST method" $ do
      bhRequestMethod req `shouldBe` "POST"

    it "attaches the encoded body" $ do
      bhRequestBody req `shouldBe` Just (encode body)

    it "carries no query string by default" $ do
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "forwards options as query params in the With variant" $ do
      let opts = defaultSearchableSnapshotMountOptions {ssmoStorage = Just SearchableSnapshotStorageSharedCache}
          req' = Common.mountSearchableSnapshotWith (SnapshotRepoName "r") (SnapshotName "s") body opts
      getRawEndpointQueries (bhRequestEndpoint req')
        `shouldBe` [("storage", Just "shared_cache")]

  describe "getSearchableSnapshotsStats endpoint shape" $ do
    let req = Common.getSearchableSnapshotsStats

    it "GETs /_searchable_snapshots/stats" $ do
      getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_searchable_snapshots", "stats"]

    it "uses the GET method" $ do
      bhRequestMethod req `shouldBe` "GET"

    it "carries no request body" $ do
      bhRequestBody req `shouldBe` Nothing

  describe "getSearchableSnapshotsCacheStats endpoint shape" $ do
    let req = Common.getSearchableSnapshotsCacheStats [qqIndexName|fs|]

    it "POSTs /_searchable_snapshots/{index}/_cache_stats" $ do
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_searchable_snapshots", "fs", "_cache_stats"]

    it "uses the POST method" $ do
      bhRequestMethod req `shouldBe` "POST"

    it "sends an empty body" $ do
      bhRequestBody req `shouldBe` Just ""

  describe "clearSearchableSnapshotsCache endpoint shape" $ do
    let req = Common.clearSearchableSnapshotsCache [qqIndexName|fs|]

    it "POSTs /_searchable_snapshots/{index}/_clear_cache" $ do
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_searchable_snapshots", "fs", "_clear_cache"]

    it "uses the POST method (matches ES docs, not the bead's PUT)" $ do
      bhRequestMethod req `shouldBe` "POST"

    it "sends an empty body" $ do
      bhRequestBody req `shouldBe` Just ""