packages feed

bloodhound-1.0.0.0: tests/Test/RollupSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.RollupSpec (spec) where

import Data.Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as MapS
import TestsUtils.Import
import Prelude

-- | The canonical @sensor@ PUT body, quoted verbatim from the
-- <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/rollup-put-job.html ES 7.17 docs>.
samplePutConfigBytes :: LBS.ByteString
samplePutConfigBytes =
  "{\
  \  \"index_pattern\": \"sensor-*\",\
  \  \"rollup_index\": \"sensor_rollup\",\
  \  \"cron\": \"*/30 * * * * ?\",\
  \  \"page_size\": 1000,\
  \  \"groups\": {\
  \    \"date_histogram\": {\
  \      \"field\": \"timestamp\",\
  \      \"fixed_interval\": \"1h\",\
  \      \"delay\": \"7d\"\
  \    },\
  \    \"terms\": {\
  \      \"fields\": [\"node\"]\
  \    }\
  \  },\
  \  \"metrics\": [\
  \    {\"field\": \"temperature\", \"metrics\": [\"min\", \"max\", \"sum\"]},\
  \    {\"field\": \"voltage\", \"metrics\": [\"avg\"]}\
  \  ]\
  \}"

-- | The @sensor@ job's @config@ as returned by GET, with the
-- server-injected @id@, the defaulted @time_zone@ and @timeout@. Verbatim
-- shape from the
-- <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/rollup-get-job.html get-job docs>.
sampleGetConfigBytes :: LBS.ByteString
sampleGetConfigBytes =
  "{\
  \  \"id\": \"sensor\",\
  \  \"index_pattern\": \"sensor-*\",\
  \  \"rollup_index\": \"sensor_rollup\",\
  \  \"cron\": \"*/30 * * * * ?\",\
  \  \"groups\": {\
  \    \"date_histogram\": {\
  \      \"fixed_interval\": \"1h\",\
  \      \"delay\": \"7d\",\
  \      \"field\": \"timestamp\",\
  \      \"time_zone\": \"UTC\"\
  \    },\
  \    \"terms\": {\"fields\": [\"node\"]}\
  \  },\
  \  \"metrics\": [\
  \    {\"field\": \"temperature\", \"metrics\": [\"min\", \"max\", \"sum\"]},\
  \    {\"field\": \"voltage\", \"metrics\": [\"avg\"]}\
  \  ],\
  \  \"timeout\": \"20s\",\
  \  \"page_size\": 1000\
  \}"

-- | A full @GET /_rollup/job/sensor@ response: a single job with config,
-- status (@stopped@, @upgraded_doc_id@ true) and zeroed stats. Shape from
-- the get-job docs.
sampleGetJobResponseBytes :: LBS.ByteString
sampleGetJobResponseBytes =
  "{\
  \  \"jobs\": [\
  \    {\
  \      \"config\": {\
  \        \"id\": \"sensor\",\
  \        \"index_pattern\": \"sensor-*\",\
  \        \"rollup_index\": \"sensor_rollup\",\
  \        \"cron\": \"*/30 * * * * ?\",\
  \        \"groups\": {\
  \          \"date_histogram\": {\
  \            \"fixed_interval\": \"1h\", \"delay\": \"7d\",\
  \            \"field\": \"timestamp\", \"time_zone\": \"UTC\"\
  \          },\
  \          \"terms\": {\"fields\": [\"node\"]}\
  \        },\
  \        \"metrics\": [\
  \          {\"field\": \"temperature\", \"metrics\": [\"min\", \"max\", \"sum\"]},\
  \          {\"field\": \"voltage\", \"metrics\": [\"avg\"]}\
  \        ],\
  \        \"timeout\": \"20s\", \"page_size\": 1000\
  \      },\
  \      \"status\": {\"job_state\": \"stopped\", \"upgraded_doc_id\": true},\
  \      \"stats\": {\
  \        \"pages_processed\": 0, \"documents_processed\": 0,\
  \        \"rollups_indexed\": 0, \"trigger_count\": 0,\
  \        \"index_failures\": 0, \"index_time_in_ms\": 0, \"index_total\": 0,\
  \        \"search_failures\": 0, \"search_time_in_ms\": 0, \"search_total\": 0,\
  \        \"processing_time_in_ms\": 0, \"processing_total\": 0\
  \      }\
  \    }\
  \  ]\
  \}"

-- | A populated @GET /_rollup/job/sensor/_stats@ response: a single
-- @job_stats@ entry with non-zero counters and a @started@ state.
sampleStatsResponseBytes :: LBS.ByteString
sampleStatsResponseBytes =
  "{\
  \  \"job_stats\": [\
  \    {\
  \      \"job_id\": \"sensor\",\
  \      \"state\": {\"job_state\": \"started\", \"upgraded_doc_id\": true},\
  \      \"stats\": {\
  \        \"pages_processed\": 7, \"documents_processed\": 7000,\
  \        \"rollups_indexed\": 42, \"trigger_count\": 7,\
  \        \"index_failures\": 1, \"index_time_in_ms\": 123, \"index_total\": 43,\
  \        \"search_failures\": 0, \"search_time_in_ms\": 45, \"search_total\": 7,\
  \        \"processing_time_in_ms\": 89, \"processing_total\": 7\
  \      }\
  \    }\
  \  ]\
  \}"

-- | The @GET /_rollup/data/sensor-*@ response, verbatim shape from the
-- <https://www.elastic.co/guide/en/elasticsearch/reference/7.17/rollup-get-rollup-caps.html get-rollup-caps docs>.
sampleCapabilitiesResponseBytes :: LBS.ByteString
sampleCapabilitiesResponseBytes =
  "{\
  \  \"sensor-*\": {\
  \    \"rollup_jobs\": [\
  \      {\
  \        \"job_id\": \"sensor\",\
  \        \"rollup_index\": \"sensor_rollup\",\
  \        \"index_pattern\": \"sensor-*\",\
  \        \"fields\": {\
  \          \"node\": [{\"agg\": \"terms\"}],\
  \          \"temperature\": [{\"agg\": \"min\"}, {\"agg\": \"max\"}, {\"agg\": \"sum\"}],\
  \          \"timestamp\": [{\"agg\": \"date_histogram\", \"time_zone\": \"UTC\", \"fixed_interval\": \"1h\", \"delay\": \"7d\"}],\
  \          \"voltage\": [{\"agg\": \"avg\"}]\
  \        }\
  \      }\
  \    ]\
  \  }\
  \}"

spec :: Spec
spec = do
  describe "RollupJobId JSON" $ do
    it "round-trips as a bare JSON string" $ do
      encode (RollupJobId "sensor") `shouldBe` "\"sensor\""
      decode "\"sensor\"" `shouldBe` Just (RollupJobId "sensor")

    it "rejects a non-string value" $ do
      (decode "42" :: Maybe RollupJobId) `shouldBe` Nothing

  describe "RollupJobMetricAgg JSON" $ do
    let table :: [(RollupJobMetricAgg, Text)]
        table =
          [ (RollupJobMetricAggAvg, "avg"),
            (RollupJobMetricAggMax, "max"),
            (RollupJobMetricAggMin, "min"),
            (RollupJobMetricAggSum, "sum"),
            (RollupJobMetricAggValueCount, "value_count")
          ]
    it "decodes the documented spellings" $
      mapM_
        ( \(agg, spelling) -> do
            decode (encode agg) `shouldBe` Just agg
            decode (encode spelling) `shouldBe` Just agg
        )
        table

    it "encodes back to the wire spelling" $
      mapM_
        (\(agg, spelling) -> encode agg `shouldBe` encode spelling)
        table

    it "absorbs an unknown metric into the Custom branch" $ do
      let Just (RollupJobMetricAggCustom t) =
            decode "\"cardinality\"" :: Maybe RollupJobMetricAgg
      t `shouldBe` "cardinality"

  describe "RollupJobConfig JSON" $ do
    it "decodes the PUT docs example" $ do
      let Just decoded = decode samplePutConfigBytes :: Maybe RollupJobConfig
      rjcId decoded `shouldBe` Nothing
      unIndexPattern (rjcIndexPattern decoded) `shouldBe` "sensor-*"
      unIndexName (rjcRollupIndex decoded) `shouldBe` "sensor_rollup"
      rjcCron decoded `shouldBe` "*/30 * * * * ?"
      rjcPageSize decoded `shouldBe` 1000
      rjcTimeout decoded `shouldBe` Nothing
      -- @date_histogram@ is mandatory and present.
      rdhgField (rgDateHistogram (rjcGroups decoded))
        `shouldBe` FieldName "timestamp"
      rdhgFixedInterval (rgDateHistogram (rjcGroups decoded))
        `shouldBe` Just "1h"
      rdhgTimeZone (rgDateHistogram (rjcGroups decoded))
        `shouldBe` Nothing
      -- @terms@ group is present, @histogram@ is not.
      rgTerms (rjcGroups decoded) `shouldSatisfy` isJust
      rgHistogram (rjcGroups decoded) `shouldBe` Nothing
      -- Two metrics were configured.
      let Just metrics = rjcMetrics decoded
      length metrics `shouldBe` 2
      rmField (NE.head metrics) `shouldBe` FieldName "temperature"

    it "decodes the GET config (server-injected id/time_zone/timeout)" $ do
      let Just decoded = decode sampleGetConfigBytes :: Maybe RollupJobConfig
      rjcId decoded `shouldBe` Just (RollupJobId "sensor")
      rjcTimeout decoded `shouldBe` Just "20s"
      rdhgTimeZone (rgDateHistogram (rjcGroups decoded))
        `shouldBe` Just "UTC"

    it "round-trips the GET config through encode . decode" $ do
      let Just decoded = decode sampleGetConfigBytes :: Maybe RollupJobConfig
          Just roundTripped = decode (encode decoded) :: Maybe RollupJobConfig
      rjcId roundTripped `shouldBe` Just (RollupJobId "sensor")
      rjcTimeout roundTripped `shouldBe` Just "20s"
      rdhgTimeZone (rgDateHistogram (rjcGroups roundTripped))
        `shouldBe` Just "UTC"

    it "round-trips the PUT config without adding server-only fields" $ do
      let Just decoded = decode samplePutConfigBytes :: Maybe RollupJobConfig
          Just roundTripped = decode (encode decoded) :: Maybe RollupJobConfig
      rjcId roundTripped `shouldBe` Nothing
      rjcTimeout roundTripped `shouldBe` Nothing
      rdhgTimeZone (rgDateHistogram (rjcGroups roundTripped))
        `shouldBe` Nothing

    it "preserves unknown sibling fields in extras" $ do
      let bytes =
            "{\
            \  \"index_pattern\": \"sensor-*\",\
            \  \"rollup_index\": \"sensor_rollup\",\
            \  \"cron\": \"*/1 * * * * ?\",\
            \  \"page_size\": 100,\
            \  \"groups\": {\"date_histogram\": {\"field\": \"timestamp\", \"fixed_interval\": \"1h\"}},\
            \  \"description\": \"sensor rollup\"\
            \}"
          Just decoded = decode bytes :: Maybe RollupJobConfig
      -- @description@ is unknown, so it lands in extras (and the known
      -- keys are NOT duplicated there).
      KM.lookup "description" (rjcExtras decoded) `shouldSatisfy` isJust

    it "accepts a bare-string terms fields list as a singleton" $ do
      let bytes =
            "{\
            \  \"index_pattern\": \"sensor-*\",\
            \  \"rollup_index\": \"sensor_rollup\",\
            \  \"cron\": \"*/1 * * * * ?\",\
            \  \"page_size\": 100,\
            \  \"groups\": {\
            \    \"date_histogram\": {\"field\": \"timestamp\", \"fixed_interval\": \"1h\"},\
            \    \"terms\": {\"fields\": \"node\"}\
            \  }\
            \}"
          Just decoded = decode bytes :: Maybe RollupJobConfig
      let Just terms = rgTerms (rjcGroups decoded)
      rtgFields terms `shouldBe` (FieldName "node" :| [])

  describe "RollupJobState JSON" $ do
    it "decodes the documented values" $ do
      decode "\"stopped\"" `shouldBe` Just RollupJobStateStopped
      decode "\"started\"" `shouldBe` Just RollupJobStateStarted
      decode "\"indexing\"" `shouldBe` Just RollupJobStateIndexing
      decode "\"abort\"" `shouldBe` Just RollupJobStateAbort

    it "encodes documented values back to the wire spelling" $ do
      encode RollupJobStateStopped `shouldBe` "\"stopped\""
      encode RollupJobStateStarted `shouldBe` "\"started\""

    it "absorbs an unknown state into the Custom branch" $ do
      let Just (RollupJobStateCustom t) =
            decode "\"retrying\"" :: Maybe RollupJobState
      t `shouldBe` "retrying"

  describe "RollupJobStats JSON" $ do
    it "defaults every counter to 0 on an empty object" $ do
      let Just decoded = decode "{}" :: Maybe RollupJobStats
      rstatPagesProcessed decoded `shouldBe` 0
      rstatDocumentsProcessed decoded `shouldBe` 0
      rstatTriggerCount decoded `shouldBe` 0

    it "decodes the populated stats" $ do
      let Just decoded =
            decode
              "{\
              \  \"pages_processed\": 7, \"documents_processed\": 7000,\
              \  \"rollups_indexed\": 42, \"trigger_count\": 7,\
              \  \"index_failures\": 1, \"index_time_in_ms\": 123,\
              \  \"index_total\": 43, \"search_failures\": 0,\
              \  \"search_time_in_ms\": 45, \"search_total\": 7,\
              \  \"processing_time_in_ms\": 89, \"processing_total\": 7\
              \}" ::
              Maybe RollupJobStats
      rstatPagesProcessed decoded `shouldBe` 7
      rstatRollupsIndexed decoded `shouldBe` 42
      rstatIndexTimeInMs decoded `shouldBe` 123

  describe "GetRollupJobsResponse JSON" $ do
    it "decodes the single-job GET response" $ do
      let Just decoded =
            decode sampleGetJobResponseBytes :: Maybe GetRollupJobsResponse
      length (unGetRollupJobsResponse decoded) `shouldBe` 1
      let job = head (unGetRollupJobsResponse decoded)
      rjsJobState (rjStatus job) `shouldBe` RollupJobStateStopped
      rjsUpgradedDocId (rjStatus job) `shouldBe` Just True
      rjcId (rjConfig job) `shouldBe` Just (RollupJobId "sensor")
      -- All counters are zero on a freshly-created job.
      rstatTriggerCount (rjStats job) `shouldBe` 0

    it "round-trips the GET response through encode . decode" $ do
      let Just decoded =
            decode sampleGetJobResponseBytes :: Maybe GetRollupJobsResponse
          Just roundTripped =
            decode (encode decoded) :: Maybe GetRollupJobsResponse
      length (unGetRollupJobsResponse roundTripped) `shouldBe` 1

  describe "GetRollupJobStatsResponse JSON" $ do
    it "decodes a populated job_stats response" $ do
      let Just decoded =
            decode sampleStatsResponseBytes :: Maybe GetRollupJobStatsResponse
      length (unGetRollupJobStatsResponse decoded) `shouldBe` 1
      let entry = head (unGetRollupJobStatsResponse decoded)
      rjseJobId entry `shouldBe` RollupJobId "sensor"
      rjsJobState (rjseState entry) `shouldBe` RollupJobStateStarted
      rstatPagesProcessed (rjseStats entry) `shouldBe` 7
      rstatRollupsIndexed (rjseStats entry) `shouldBe` 42

    it "round-trips the stats response through encode . decode" $ do
      let Just decoded =
            decode sampleStatsResponseBytes :: Maybe GetRollupJobStatsResponse
          Just roundTripped =
            decode (encode decoded) :: Maybe GetRollupJobStatsResponse
      length (unGetRollupJobStatsResponse roundTripped) `shouldBe` 1

  describe "RollupCapabilitiesResponse JSON" $ do
    it "decodes the get-rollup-caps response" $ do
      let Just decoded =
            decode sampleCapabilitiesResponseBytes ::
              Maybe RollupCapabilitiesResponse
      -- Keyed by the source index pattern.
      let Just indexCaps = lookupRollupCapabilities "sensor-*" decoded
      length (ricJobs indexCaps) `shouldBe` 1
      let jobCap = head (ricJobs indexCaps)
      rjcJobId jobCap `shouldBe` RollupJobId "sensor"
      unIndexName (rjcRollupIndexCap jobCap) `shouldBe` "sensor_rollup"
      -- Four fields are eligible; @temperature@ supports min/max/sum.
      length (rjcFields jobCap) `shouldBe` 4
      let Just tempCaps = lookup "temperature" (toList' (rjcFields jobCap))
      length tempCaps `shouldBe` 3
      rfcAgg (head tempCaps) `shouldBe` RollupCapabilityAggMin
      -- @timestamp@ carries the date_histogram interval metadata.
      let Just tsCaps = lookup "timestamp" (toList' (rjcFields jobCap))
      rfcFixedInterval (head tsCaps) `shouldBe` Just "1h"
      rfcTimeZone (head tsCaps) `shouldBe` Just "UTC"

    it "returns Nothing for an unknown index pattern" $ do
      let Just decoded =
            decode sampleCapabilitiesResponseBytes ::
              Maybe RollupCapabilitiesResponse
      lookupRollupCapabilities "nope" decoded `shouldBe` Nothing

    it "round-trips the capabilities response through encode . decode" $ do
      let Just decoded =
            decode sampleCapabilitiesResponseBytes ::
              Maybe RollupCapabilitiesResponse
          Just roundTripped =
            decode (encode decoded) :: Maybe RollupCapabilitiesResponse
      lookupRollupCapabilities "sensor-*" roundTripped `shouldSatisfy` isJust

  describe "RollupCapabilityAgg JSON" $ do
    it "decodes the documented agg spellings" $ do
      decode "\"avg\"" `shouldBe` Just RollupCapabilityAggAvg
      decode "\"terms\"" `shouldBe` Just RollupCapabilityAggTerms
      decode "\"histogram\"" `shouldBe` Just RollupCapabilityAggHistogram
      decode "\"date_histogram\""
        `shouldBe` Just RollupCapabilityAggDateHistogram
      decode "\"value_count\""
        `shouldBe` Just RollupCapabilityAggValueCount

    it "absorbs an unknown agg into the Custom branch" $ do
      let Just (RollupCapabilityAggCustom t) =
            decode "\"percentiles\"" :: Maybe RollupCapabilityAgg
      t `shouldBe` "percentiles"

  describe "RollupJobStarted / RollupJobStopped JSON" $ do
    it "decodes {\"started\": true}" $ do
      decode "{\"started\": true}" `shouldBe` Just (RollupJobStarted True)
    it "decodes {\"stopped\": true}" $ do
      decode "{\"stopped\": true}" `shouldBe` Just (RollupJobStopped True)
    it "defaults started/stopped to True on a missing flag" $ do
      decode "{}" `shouldBe` Just (RollupJobStarted True)
      decode "{}" `shouldBe` Just (RollupJobStopped True)

  describe "StopRollupJobOptions params" $ do
    it "default options emit no query params" $ do
      stopRollupJobOptionsParams defaultStopRollupJobOptions
        `shouldBe` []

    it "emits wait_for_completion as true/false" $ do
      let opts =
            defaultStopRollupJobOptions
              { srjoWaitForCompletion = Just True
              }
      stopRollupJobOptionsParams opts
        `shouldBe` [("wait_for_completion", Just "true")]

    it "emits both params when both are set" $ do
      let opts =
            defaultStopRollupJobOptions
              { srjoWaitForCompletion = Just False,
                srjoTimeout = Just "10s"
              }
      stopRollupJobOptionsParams opts
        `shouldContain` [("wait_for_completion", Just "false")]
      stopRollupJobOptionsParams opts
        `shouldContain` [("timeout", Just "10s")]

  describe "Endpoint shapes" $ do
    it "putRollupJob is a PUT to /_rollup/job/{id} with the config body" $ do
      let req = putRollupJob "sensor" (defaultRollupJobConfig (IndexPattern "sensor-*") (mkIndexName' "sensor_rollup") "*/1 * * * * ?" 100 (defaultRollupDateHistogramGroup (FieldName "timestamp") "1h"))
      bhRequestMethod req `shouldBe` "PUT"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job", "sensor"]
      bhRequestBody req `shouldSatisfy` isJust

    it "getRollupJob (Nothing) lists all jobs" $ do
      let req = getRollupJob Nothing
      bhRequestMethod req `shouldBe` "GET"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      bhRequestBody req `shouldBe` Nothing

    it "getRollupJob (Just id) targets one job" $ do
      let req = getRollupJob (Just "sensor")
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job", "sensor"]

    it "deleteRollupJob is a DELETE to /_rollup/job/{id}" $ do
      let req = deleteRollupJob "sensor"
      bhRequestMethod req `shouldBe` "DELETE"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job", "sensor"]
      bhRequestBody req `shouldBe` Nothing

    it "startRollupJob is a POST to /_rollup/job/{id}/_start with no body" $ do
      let req = startRollupJob "sensor"
      bhRequestMethod req `shouldBe` "POST"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job", "sensor", "_start"]
      bhRequestBody req `shouldBe` Nothing

    it "stopRollupJob defaults to no query params" $ do
      let req = stopRollupJob "sensor"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["_rollup", "job", "sensor", "_stop"]
      getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []

    it "stopRollupJobWith forwards wait_for_completion and timeout" $ do
      let opts =
            defaultStopRollupJobOptions
              { srjoWaitForCompletion = Just True,
                srjoTimeout = Just "10s"
              }
          req = stopRollupJobWith "sensor" opts
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldContain` [("wait_for_completion", Just "true")]
      getRawEndpointQueries (bhRequestEndpoint req)
        `shouldContain` [("timeout", Just "10s")]

    it "getRollupJobStats (Nothing) targets /_rollup/job/_stats" $ do
      getRawEndpoint (bhRequestEndpoint (getRollupJobStats Nothing))
        `shouldBe` ["_rollup", "job", "_stats"]
      getRawEndpoint (bhRequestEndpoint (getRollupJobStats (Just "sensor")))
        `shouldBe` ["_rollup", "job", "sensor", "_stats"]

    it "getRollupCapabilities targets /_rollup/data/{index}" $ do
      getRawEndpoint
        (bhRequestEndpoint (getRollupCapabilities (IndexPattern "sensor-*")))
        `shouldBe` ["_rollup", "data", "sensor-*"]

    it "getRollupIndexCapabilities targets /{target}/_rollup/data" $ do
      getRawEndpoint
        ( bhRequestEndpoint
            (getRollupIndexCapabilities (mkIndexName' "sensor_rollup"))
        )
        `shouldBe` ["sensor_rollup", "_rollup", "data"]

    it "rollupSearchByIndex is a GET to /{index}/_rollup_search with body" $ do
      let req = rollupSearchByIndex (mkIndexName' "sensor_rollup") (mkSearch Nothing Nothing) :: BHRequest StatusDependant (SearchResult Value)
      bhRequestMethod req `shouldBe` "GET"
      getRawEndpoint (bhRequestEndpoint req)
        `shouldBe` ["sensor_rollup", "_rollup_search"]
      bhRequestBody req `shouldSatisfy` isJust

-- | Local helpers to keep the endpoint-shape tests terse. @mkIndexName@
-- returns 'Either' because rollup indices must satisfy the ES naming
-- rules; the test fixtures use valid names so the @Right@ is total.
mkIndexName' :: Text -> IndexName
mkIndexName' = either (error . ("bad IndexName: " <>) . show) id . mkIndexName

-- | 'Data.Map.Strict.toList' pulled in under a short name for the
-- capabilities field-map assertions.
toList' :: MapS.Map k v -> [(k, v)]
toList' = MapS.toList