bloodhound-1.0.0.0: tests/Test/WatcherSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.WatcherSpec (spec) where
import Data.Aeson
import Data.Aeson.Key (fromText, toText)
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
------------------------------------------------------------------------------
-- Sample payloads (shaped after the ES 7.17 Watcher docs)
------------------------------------------------------------------------------
-- | Minimal @PUT /_watcher/watch/{id}@ body: a schedule + a simple input +
-- a condition + one logging action. The DSL is opaque on the Haskell side
-- (see "Database.Bloodhound.Internal.Versions.Common.Types.Watcher"), so
-- the spec only checks that the carried 'Value' round-trips verbatim.
samplePutBodyBytes :: LBS.ByteString
samplePutBodyBytes =
"{\
\ \"trigger\": {\"schedule\": {\"cron\": \"0 0/5 * * * ?\"}},\
\ \"input\": {\"search\": {\"request\": {\"indices\": [\"logs-*\"], \"body\": {\"size\": 0}}}},\
\ \"condition\": {\"compare\": {\"ctx.payload.hits.total\": {\"gt\": 5}}},\
\ \"actions\": {\"log_hits\": {\"logging\": {\"text\": \"found {{ctx.payload.hits.total}} hits\"}}}\
\}"
-- | @GET /_watcher/watch/{id}@ response: the typed envelope (@_id@,
-- @_version@, @found@, @_seq_no@, @_primary_term@) plus an opaque @watch@
-- sub-object and a typed @status@ sub-object carrying @state@ +
-- @version@ + an unknown sibling (@last_checked@) that should land in
-- @wsExtras@.
sampleGetResponseBytes :: LBS.ByteString
sampleGetResponseBytes =
"{\
\ \"_id\": \"log_event_watch\",\
\ \"_version\": 2,\
\ \"_seq_no\": 4,\
\ \"_primary_term\": 1,\
\ \"found\": true,\
\ \"watch\": {\
\ \"trigger\": {\"schedule\": {\"cron\": \"0 0/5 * * * ?\"}},\
\ \"input\": {\"none\": {}},\
\ \"condition\": {\"always\": {}},\
\ \"actions\": {\"log_hits\": {\"logging\": {\"text\": \"hi\"}}}\
\ },\
\ \"status\": {\
\ \"state\": \"active\",\
\ \"version\": 2,\
\ \"last_checked\": \"2024-05-29T13:37:00.000Z\"\
\ }\
\}"
-- | @POST /_watcher/watch/{id}/_execute@ response: a typed @_id@ plus an
-- opaque @watch_record@, with an unknown sibling (@node@) for the extras
-- catch-all.
sampleExecuteResponseBytes :: LBS.ByteString
sampleExecuteResponseBytes =
"{\
\ \"_id\": \"log_event_watch\",\
\ \"watch_record\": {\
\ \"watch_id\": \"log_event_watch\",\
\ \"state\": \"executed\",\
\ \"input_event\": {},\
\ \"metadata\": {},\
\ \"actions\": []\
\ },\
\ \"node\": \"node-1\"\
\}"
-- | @PUT /_watcher/watch/{id}/_ack@ response: top-level @ack_state@ plus a
-- nested @ack_watch_status@.
sampleAckResponseBytes :: LBS.ByteString
sampleAckResponseBytes =
"{\
\ \"ack_state\": \"acks_needed\",\
\ \"ack_watch_status\": {\
\ \"ack_state\": \"acks_needed\",\
\ \"state\": \"active\",\
\ \"version\": 3\
\ }\
\}"
-- | @PUT /_watcher/watch/{id}/_activate@ (or @_deactivate@) response.
sampleActivationResponseBytes :: LBS.ByteString
sampleActivationResponseBytes =
"{\
\ \"ack_state\": \"acks_needed\",\
\ \"state\": \"active\",\
\ \"version\": 2\
\}"
-- | @GET /_watcher/_stats@ response.
sampleStatsResponseBytes :: LBS.ByteString
sampleStatsResponseBytes =
"{\
\ \"_nodes\": {\"total\": 1, \"successful\": 1, \"failed\": 0},\
\ \"cluster_name\": \"elasticsearch\",\
\ \"stats\": {\
\ \"watch_count\": 5,\
\ \"execution_state\": \"started\",\
\ \"pending_watches\": 0,\
\ \"thread_pool\": {\"queue_size\": 0, \"max_size\": 0},\
\ \"current_watches\": []\
\ }\
\}"
-- | @GET /_watcher/settings@ response.
sampleSettingsResponseBytes :: LBS.ByteString
sampleSettingsResponseBytes =
"{\
\ \"persistent\": {\"xpack\": {\"watcher\": {\"execution\": {\"scroll\": {\"size\": 100}}}}},\
\ \"transient\": {},\
\ \"defaults\": {\"xpack\": {\"watcher\": {\"enabled\": true}}}\
\}"
------------------------------------------------------------------------------
-- JSON round-trip / decode tests
------------------------------------------------------------------------------
spec :: Spec
spec = describe "X-Pack Watcher API" $ do
describe "WatchId JSON" $ do
it "round-trips as a bare JSON string" $ do
let Just decoded = decode "\"my-watch\"" :: Maybe WatchId
unWatchId decoded `shouldBe` "my-watch"
encode (WatchId "my-watch") `shouldBe` "\"my-watch\""
it "rejects a non-string value" $ do
let decoded = decode "42" :: Maybe WatchId
decoded `shouldBe` Nothing
describe "WatchBody JSON (PUT body)" $ do
it "encodes the carried Value verbatim" $ do
let body = object ["trigger" .= object ["schedule" .= object ["cron" .= String "0 0 0 * * ?"]]]
encoded = encode (WatchBody body)
encoded `shouldBe` encode body
it "decodes an object body verbatim" $ do
let Just decoded = decode samplePutBodyBytes :: Maybe WatchBody
Just expected = decode samplePutBodyBytes :: Maybe Value
unWatchBody decoded `shouldBe` expected
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode samplePutBodyBytes :: Maybe WatchBody
(decode . encode) decoded `shouldBe` Just decoded
it "rejects a non-object body (array)" $ do
let decoded = decode "[1,2,3]" :: Maybe WatchBody
decoded `shouldBe` Nothing
it "rejects a non-object body (bare number)" $ do
let decoded = decode "5" :: Maybe WatchBody
decoded `shouldBe` Nothing
describe "WatchState JSON" $ do
it "round-trips known constructors" $ do
encode WatchStateActive `shouldBe` "\"active\""
encode WatchStateInactive `shouldBe` "\"inactive\""
encode WatchStateAcknowledged `shouldBe` "\"acknowledged\""
encode WatchStateExecutionFailed `shouldBe` "\"execution_failed\""
it "falls back to WatchStateCustom for unknown values" $ do
let Just decoded = decode "\"primordial\"" :: Maybe WatchState
decoded `shouldBe` WatchStateCustom "primordial"
encode decoded `shouldBe` "\"primordial\""
describe "Watch (GET response) JSON" $ do
it "decodes the typed envelope + opaque body + typed status" $ do
let Just decoded = decode sampleGetResponseBytes :: Maybe Watch
watchId decoded `shouldBe` WatchId "log_event_watch"
watchVersion decoded `shouldBe` Just 2
watchSeqNo decoded `shouldBe` Just 4
watchPrimaryTerm decoded `shouldBe` Just 1
watchFound decoded `shouldBe` Just True
wsState <$> watchStatus decoded `shouldBe` Just (Just WatchStateActive)
wsVersion <$> watchStatus decoded `shouldBe` Just (Just 2)
it "collects unknown status siblings into wsExtras" $ do
let Just decoded = decode sampleGetResponseBytes :: Maybe Watch
status = watchStatus decoded
status `shouldSatisfy` isJust
let Just s = status
Just extras = wsExtras s
extras `shouldContainKey` "last_checked"
it "stamps a placeholder id when @_id@ is absent" $ do
let Just decoded = decode "{\"found\": false}" :: Maybe Watch
watchId decoded `shouldBe` WatchId ""
it "round-trips through ToJSON/FromJSON (modulo the extras catch-all)" $ do
let Just decoded = decode sampleGetResponseBytes :: Maybe Watch
(decode . encode) decoded `shouldBe` Just decoded
describe "ExecuteWatchResponse JSON" $ do
it "decodes the typed id + opaque watch_record" $ do
let Just decoded = decode sampleExecuteResponseBytes :: Maybe ExecuteWatchResponse
ewrId decoded `shouldBe` WatchId "log_event_watch"
ewrWatchRecord decoded `shouldSatisfy` isJust
it "collects unknown siblings into ewrExtras" $ do
let Just decoded = decode sampleExecuteResponseBytes :: Maybe ExecuteWatchResponse
Just extras = ewrExtras decoded
extras `shouldContainKey` "node"
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode sampleExecuteResponseBytes :: Maybe ExecuteWatchResponse
(decode . encode) decoded `shouldBe` Just decoded
describe "AckState JSON" $ do
it "round-trips known constructors" $ do
encode AckStateAcksNeeded `shouldBe` "\"acks_needed\""
encode AckStateAcksRequired `shouldBe` "\"acks_required\""
it "falls back to AckStateCustom for unknown values" $ do
let Just decoded = decode "\"weird\"" :: Maybe AckState
decoded `shouldBe` AckStateCustom "weird"
describe "WatchExecutionState JSON" $ do
it "round-trips known constructors" $ do
encode WatchExecutionStateActive `shouldBe` "\"active\""
encode WatchExecutionStateInactive `shouldBe` "\"inactive\""
encode WatchExecutionStateExecuted `shouldBe` "\"executed\""
encode WatchExecutionStateThrottled `shouldBe` "\"throttled\""
it "falls back to WatchExecutionStateCustom for unknown values" $ do
let Just decoded = decode "\"frozen\"" :: Maybe WatchExecutionState
decoded `shouldBe` WatchExecutionStateCustom "frozen"
describe "AckWatchResponse JSON" $ do
it "decodes the top-level ack_state + nested ack_watch_status" $ do
let Just decoded = decode sampleAckResponseBytes :: Maybe AckWatchResponse
awrAckState decoded `shouldBe` Just AckStateAcksNeeded
awrWatchStatus decoded `shouldSatisfy` isJust
let Just nested = awrWatchStatus decoded
wsrState nested `shouldBe` Just WatchExecutionStateActive
wsrVersion nested `shouldBe` Just 3
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode sampleAckResponseBytes :: Maybe AckWatchResponse
(decode . encode) decoded `shouldBe` Just decoded
describe "WatchStateResponse JSON (activate/deactivate)" $ do
it "decodes ack_state + state + version" $ do
let Just decoded = decode sampleActivationResponseBytes :: Maybe WatchStateResponse
wsrAckState decoded `shouldBe` Just AckStateAcksNeeded
wsrState decoded `shouldBe` Just WatchExecutionStateActive
wsrVersion decoded `shouldBe` Just 2
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode sampleActivationResponseBytes :: Maybe WatchStateResponse
(decode . encode) decoded `shouldBe` Just decoded
describe "WatcherStatsResponse JSON" $ do
it "decodes the typed summary fields" $ do
let Just decoded = decode sampleStatsResponseBytes :: Maybe WatcherStatsResponse
watcherStatsClusterName decoded `shouldBe` Just "elasticsearch"
watcherStatsStats decoded `shouldSatisfy` isJust
let Just summary = watcherStatsStats decoded
wssWatchCount summary `shouldBe` Just 5
wssExecutionState summary `shouldBe` Just "started"
wssPendingWatches summary `shouldBe` Just 0
wssThreadPool summary `shouldSatisfy` isJust
it "collects unknown summary siblings into wssExtras" $ do
let Just decoded = decode sampleStatsResponseBytes :: Maybe WatcherStatsResponse
Just summary = watcherStatsStats decoded
Just extras = wssExtras summary
extras `shouldContainKey` "current_watches"
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode sampleStatsResponseBytes :: Maybe WatcherStatsResponse
(decode . encode) decoded `shouldBe` Just decoded
describe "WatcherSettings JSON" $ do
it "decodes persistent/transient/defaults" $ do
let Just decoded = decode sampleSettingsResponseBytes :: Maybe WatcherSettings
watcherSettingsPersistent decoded `shouldSatisfy` isJust
watcherSettingsTransient decoded `shouldSatisfy` isJust
watcherSettingsDefaults decoded `shouldSatisfy` isJust
it "round-trips through ToJSON/FromJSON" $ do
let Just decoded = decode sampleSettingsResponseBytes :: Maybe WatcherSettings
(decode . encode) decoded `shouldBe` Just decoded
describe "ExecuteWatchOptions params" $ do
it "omits Nothing fields" $ do
executeWatchOptionsParams defaultExecuteWatchOptions `shouldBe` []
it "renders set fields as true/false strings" $ do
let opts =
defaultExecuteWatchOptions
{ ewoDebug = Just True,
ewoRecordExecution = Just False
}
executeWatchOptionsParams opts
`shouldBe` [("debug", Just "true"), ("record_execution", Just "false")]
describe "WatcherStatsMetric path" $ do
it "renders the built-in metrics" $ do
watcherStatsMetricPath WatcherStatsMetricAll `shouldBe` "_all"
watcherStatsMetricPath WatcherStatsMetricQueuedWatches
`shouldBe` "queued_watches"
watcherStatsMetricPath WatcherStatsMetricPendingWatches
`shouldBe` "pending_watches"
watcherStatsMetricPath WatcherStatsMetricExecutionThreadPool
`shouldBe` "execution_thread_pool"
it "round-trips a custom metric" $ do
watcherStatsMetricPath (WatcherStatsMetricCustom "custom_metric")
`shouldBe` "custom_metric"
------------------------------------------------------------------------------
-- Request-builder endpoint shapes
------------------------------------------------------------------------------
describe "putWatch endpoint shape" $ do
let body = WatchBody (object ["trigger" .= object ["schedule" .= object ["cron" .= String "0 0 * * * ?"]]])
req = Common.putWatch (WatchId "my-watch") body
it "PUTs /_watcher/watch/{id}" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "my-watch"]
it "uses the PUT method" $ do
bhRequestMethod req `shouldBe` "PUT"
it "attaches the encoded body" $ do
bhRequestBody req `shouldBe` Just (encode body)
it "carries no query string" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "getWatch endpoint shape" $ do
let req = Common.getWatch (WatchId "log_event_watch")
it "GETs /_watcher/watch/{id}" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "log_event_watch"]
it "uses the GET method" $ do
bhRequestMethod req `shouldBe` "GET"
it "carries no request body" $ do
bhRequestBody req `shouldBe` Nothing
it "carries no query string" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "deleteWatch endpoint shape" $ do
let req = Common.deleteWatch (WatchId "stale")
it "DELETEs /_watcher/watch/{id}" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "stale"]
it "uses the DELETE method" $ do
bhRequestMethod req `shouldBe` "DELETE"
it "carries no request body" $ do
bhRequestBody req `shouldBe` Nothing
describe "executeWatch endpoint shape (no body, no options)" $ do
let req = Common.executeWatch (WatchId "log_event_watch")
it "POSTs /_watcher/watch/{id}/_execute" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "log_event_watch", "_execute"]
it "uses the POST method" $ do
bhRequestMethod req `shouldBe` "POST"
it "sends an empty body" $ do
bhRequestBody req `shouldBe` Just ""
it "carries no query string by default" $ do
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "executeWatchWith endpoint shape (body + options)" $ do
let opts =
defaultExecuteWatchOptions
{ ewoDebug = Just True,
ewoRecordExecution = Just False
}
inlineBody =
Just
( ExecuteWatchRequest
( object
[ "trigger" .= object ["schedule" .= object ["cron" .= String "0 0 * * * ?"]],
"input" .= object ["none" .= object []]
]
)
)
req = Common.executeWatchWith opts (WatchId "w") inlineBody
it "POSTs /_watcher/watch/{id}/_execute with the right path" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "w", "_execute"]
it "uses the POST method" $ do
bhRequestMethod req `shouldBe` "POST"
it "attaches the encoded inline body" $ do
bhRequestBody req `shouldSatisfy` isJust
it "emits the debug and record_execution query params" $ do
getRawEndpointQueries (bhRequestEndpoint req)
`shouldContain` [("debug", Just "true"), ("record_execution", Just "false")]
describe "ackWatch endpoint shape" $ do
let req = Common.ackWatch (WatchId "w")
it "PUTs /_watcher/watch/{id}/_ack" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "w", "_ack"]
it "uses the PUT method" $ do
bhRequestMethod req `shouldBe` "PUT"
it "sends an empty body" $ do
bhRequestBody req `shouldBe` Just ""
describe "activateWatch endpoint shape" $ do
let req = Common.activateWatch (WatchId "w")
it "PUTs /_watcher/watch/{id}/_activate" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "w", "_activate"]
it "uses the PUT method" $ do
bhRequestMethod req `shouldBe` "PUT"
it "sends an empty body" $ do
bhRequestBody req `shouldBe` Just ""
describe "deactivateWatch endpoint shape" $ do
let req = Common.deactivateWatch (WatchId "w")
it "PUTs /_watcher/watch/{id}/_deactivate" $ do
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "watch", "w", "_deactivate"]
it "uses the PUT method" $ do
bhRequestMethod req `shouldBe` "PUT"
it "sends an empty body" $ do
bhRequestBody req `shouldBe` Just ""
describe "watcherStats endpoint shape" $ do
it "GETs /_watcher/_stats with Nothing" $ do
let req = Common.watcherStats
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_watcher", "_stats"]
bhRequestMethod req `shouldBe` "GET"
bhRequestBody req `shouldBe` Nothing
it "GETs /_watcher/_stats/{metric} with a specific metric" $ do
let req = Common.watcherStatsWith (Just WatcherStatsMetricQueuedWatches)
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "_stats", "queued_watches"]
bhRequestMethod req `shouldBe` "GET"
it "expands WatcherStatsMetricAll to /_watcher/_stats/_all" $ do
let req = Common.watcherStatsWith (Just WatcherStatsMetricAll)
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "_stats", "_all"]
it "round-trips a custom metric through the path" $ do
let req = Common.watcherStatsWith (Just (WatcherStatsMetricCustom "custom"))
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_watcher", "_stats", "custom"]
describe "getWatcherSettings endpoint shape" $ do
let req = Common.getWatcherSettings
it "GETs /_watcher/settings" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_watcher", "settings"]
bhRequestMethod req `shouldBe` "GET"
bhRequestBody req `shouldBe` Nothing
describe "updateWatcherSettings endpoint shape" $ do
let body =
WatcherSettings
{ watcherSettingsPersistent =
Just (object ["xpack" .= object ["watcher" .= object ["enabled" .= Bool True]]]),
watcherSettingsTransient = Nothing,
watcherSettingsDefaults = Nothing,
watcherSettingsExtras = Nothing
}
req = Common.updateWatcherSettings body
it "PUTs /_watcher/settings" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_watcher", "settings"]
bhRequestMethod req `shouldBe` "PUT"
bhRequestBody req `shouldBe` Just (encode body)
describe "startWatcher endpoint shape" $ do
let req = Common.startWatcher
it "POSTs /_watcher/_start" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_watcher", "_start"]
bhRequestMethod req `shouldBe` "POST"
bhRequestBody req `shouldBe` Just ""
describe "stopWatcher endpoint shape" $ do
let req = Common.stopWatcher
it "POSTs /_watcher/_stop" $ do
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["_watcher", "_stop"]
bhRequestMethod req `shouldBe` "POST"
bhRequestBody req `shouldBe` Just ""
------------------------------------------------------------------------------
-- Helpers
------------------------------------------------------------------------------
-- | Assert that a 'KM.KeyMap' contains the given key. The 'Text' argument
-- is converted with 'fromText' so the spec reads naturally.
shouldContainKey ::
(HasCallStack, Show a) =>
KM.KeyMap a ->
Text ->
Expectation
shouldContainKey km key
| KM.member (fromText key) km = pure ()
| otherwise =
expectationFailure $
"expected KeyMap to contain key "
<> show key
<> ", got keys: "
<> show (map toText (KM.keys km))