FieldUsageStatsSpec.hs

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

module Test.FieldUsageStatsSpec (spec) where

import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy qualified as LBS
import Data.List (sort)
import Database.Bloodhound.Common.Types
import Optics (set, view)
import TestsUtils.Common
import TestsUtils.Import

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

-- | A trimmed slice of the documented response: @\"_shards\"@ + one
-- index with a single shard carrying routing and a stats object.
sampleResponseBytes :: LBS.ByteString
sampleResponseBytes =
  "{\"_shards\":{\"total\":1,\"successful\":1,\"failed\":0},\
  \\"my-index-000001\":{\"shards\":[{\
  \\"tracking_id\":\"MpOl0QlTQ4SYYhEe6KgJoQ\",\
  \\"tracking_started_at_millis\":1625558985010,\
  \\"routing\":{\"state\":\"STARTED\",\"primary\":true,\"node\":\"n1\",\"relocating_node\":null},\
  \\"stats\":{\"all_fields\":{\"any\":6,\"inverted_index\":{\"terms\":1,\"postings\":1},\
  \\"stored_fields\":2,\"doc_values\":1,\"points\":0,\"norms\":1,\"term_vectors\":0},\
  \\"fields\":{\"_id\":{\"any\":1,\"stored_fields\":1}}}}]}}"

spec :: Spec
spec = do
  -- ------------------------------------------------------------------ --
  -- Pure JSON decoder tests (no ES required).                          --
  -- ------------------------------------------------------------------ --
  describe "FieldUsageStatsResponse JSON parsing" $ do
    it "peels _shards and parses the nested shard/stats structure" $ do
      let Just (r :: FieldUsageStatsResponse) = decode sampleResponseBytes
      shardTotal (fusrShards r) `shouldBe` 1
      case KM.lookup "my-index-000001" (fusrIndices r) of
        Just ix -> case fusiShards ix of
          [s] -> do
            fusTrackingId s `shouldBe` Just "MpOl0QlTQ4SYYhEe6KgJoQ"
            fusTrackingStartedAtMillis s `shouldBe` Just 1625558985010
            case fusRouting s of
              Just rt -> do
                furState rt `shouldBe` Just "STARTED"
                furPrimary rt `shouldBe` Just True
                furRelocatingNode rt `shouldBe` Nothing
              Nothing -> expectationFailure "expected routing"
            case fusStats s of
              Just st -> do
                case fustatAllFields st of
                  Just af -> do
                    fubAny af `shouldBe` Just 6
                    case fubInvertedIndex af of
                      Just ii -> fuiiTerms ii `shouldBe` Just 1
                      Nothing -> expectationFailure "expected inverted_index"
                  Nothing -> expectationFailure "expected all_fields"
                case fustatFields st of
                  Just fields -> case KM.lookup "_id" fields of
                    Just fb -> fubAny fb `shouldBe` Just 1
                    Nothing -> expectationFailure "expected _id field"
                  Nothing -> expectationFailure "expected fields map"
              Nothing -> expectationFailure "expected stats"
          other ->
            expectationFailure ("expected singleton shards list, got " <> show other)
        Nothing -> expectationFailure "expected my-index-000001 entry"

    it "round-trips the documented response via ToJSON/FromJSON" $ do
      let Just (original :: FieldUsageStatsResponse) = decode sampleResponseBytes
          reDecoded = decode (encode original) :: Maybe FieldUsageStatsResponse
      Just original `shouldBe` reDecoded

  describe "FieldUsageBreakdown JSON parsing" $ do
    let bare = "{\"any\":3,\"doc_values\":2}"
    it "parses a minimal breakdown leniently" $ do
      let Just (fb :: FieldUsageBreakdown) = decode bare
      fubAny fb `shouldBe` Just 3
      fubDocValues fb `shouldBe` Just 2
      fubInvertedIndex fb `shouldBe` Nothing

    it "round-trips via ToJSON/FromJSON" $ do
      let Just (original :: FieldUsageBreakdown) = decode bare
          reDecoded = decode (encode original) :: Maybe FieldUsageBreakdown
      Just original `shouldBe` reDecoded

  -- ------------------------------------------------------------------ --
  -- Optics.                                                            --
  -- ------------------------------------------------------------------ --
  describe "FieldUsageStats lenses" $ do
    it "fubAnyLens is a lawful get/set" $ do
      let fb = FieldUsageBreakdown Nothing Nothing Nothing Nothing Nothing Nothing Nothing
          fb' = set fubAnyLens (Just 9) fb
      view fubAnyLens fb' `shouldBe` Just 9

    it "fusoFieldsLens is a lawful get/set" $ do
      let opts = set fusoFieldsLens (Just ("a" :| [])) defaultFieldUsageStatsOptions
      view fusoFieldsLens opts `shouldBe` Just ("a" :| [])

  -- ------------------------------------------------------------------ --
  -- Options rendering.                                                 --
  -- ------------------------------------------------------------------ --
  describe "FieldUsageStatsOptions URI param rendering" $ do
    it "defaultFieldUsageStatsOptions emits no params" $
      fieldUsageStatsOptionsParams defaultFieldUsageStatsOptions
        `shouldBe` []

    it "renders fields as a comma-separated list" $ do
      let opts =
            defaultFieldUsageStatsOptions
              { fusoFields = Just ("_id" :| ["message", "*.keyword"])
              }
      lookup "fields" (fieldUsageStatsOptionsParams opts)
        `shouldBe` Just (Just "_id,message,*.keyword")

    it "renders expand_wildcards as a comma-separated list" $ do
      let opts =
            defaultFieldUsageStatsOptions
              { fusoExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsClosed])
              }
      lookup "expand_wildcards" (fieldUsageStatsOptionsParams opts)
        `shouldBe` Just (Just "open,closed")

    it "renders the accepted params together" $ do
      let opts =
            defaultFieldUsageStatsOptions
              { fusoIgnoreUnavailable = Just True,
                fusoAllowNoIndices = Just False,
                fusoFields = Just ("_id" :| ["message"])
              }
      normalize (fieldUsageStatsOptionsParams opts)
        `shouldBe` [ ("allow_no_indices", Just "false"),
                     ("fields", Just "_id,message"),
                     ("ignore_unavailable", Just "true")
                   ]

  -- ------------------------------------------------------------------ --
  -- Endpoint shape (BHRequest, no ES required).                        --
  -- ------------------------------------------------------------------ --
  describe "fieldUsageStats endpoint shape" $ do
    let idx = [qqIndexName|my-idx|]

    it "GETs /{index}/_field_usage_stats with no params by default" $ do
      let req = fieldUsageStats idx
      bhRequestMethod req `shouldBe` "GET"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["my-idx", "_field_usage_stats"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "carries no request body" $ do
      let req = fieldUsageStats idx
      bhRequestBody req `shouldBe` Nothing

    it "forwards fields via the With variant" $ do
      let opts = defaultFieldUsageStatsOptions {fusoFields = Just ("_id" :| [])}
          req = fieldUsageStatsWith opts idx
      lookup "fields" (getRawEndpointQueries (bhRequestEndpoint req))
        `shouldBe` Just (Just "_id")