BehavioralAnalyticsSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.BehavioralAnalyticsSpec (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 "Behavioral Analytics API (/_application/analytics*)" $ do
    describe "AnalyticsCollectionName / AnalyticsEventType JSON" $ do
      it "round-trips an AnalyticsCollectionName as a bare string" $ do
        let n = Types.AnalyticsCollectionName "my-collection"
        decode (encode n) `shouldBe` Just n
      it "exposes the known event types" $ do
        Types.unAnalyticsEventType Types.analyticsEventTypeSearch
          `shouldBe` ("search" :: Text)
        Types.unAnalyticsEventType Types.analyticsEventTypeSearchClick
          `shouldBe` ("search_click" :: Text)
        Types.unAnalyticsEventType Types.analyticsEventTypePageView
          `shouldBe` ("page_view" :: Text)
      it "round-trips an AnalyticsEventType via IsString" $
        decode (encode (Types.AnalyticsEventType "custom_event" :: Types.AnalyticsEventType))
          `shouldBe` Just (Types.AnalyticsEventType "custom_event")

    describe "AnalyticsCollectionsResponse (GET list) decoding" $ do
      it "flattens a name-keyed map into a list of AnalyticsCollection" $ do
        let raw =
              LBS.pack
                "{\"clicks\":{\"name\":\"clicks\"},\"searches\":{}}"
        case decode raw :: Maybe Types.AnalyticsCollectionsResponse of
          Just resp -> do
            length (Types.unAnalyticsCollectionsResponse resp) `shouldBe` 2
            let names = Types.acName <$> Types.unAnalyticsCollectionsResponse resp
            sort names `shouldBe` ["clicks", "searches"]
          Nothing ->
            expectationFailure "failed to decode AnalyticsCollectionsResponse"
      it "decodes an empty map as []" $
        decode "{}" `shouldBe` Just (Types.AnalyticsCollectionsResponse [])

    describe "AnalyticsCollectionPutResponse JSON" $ do
      it "decodes {acknowledged, name}" $
        decode "{\"acknowledged\":true,\"name\":\"clicks\"}"
          `shouldBe` Just
            ( Types.AnalyticsCollectionPutResponse
                { Types.acprAcknowledged = True,
                  Types.acprName = "clicks"
                }
            )
      it "defaults missing fields" $
        decode "{}"
          `shouldBe` Just
            ( Types.AnalyticsCollectionPutResponse
                { Types.acprAcknowledged = False,
                  Types.acprName = ""
                }
            )

    describe "AnalyticsEventResponse JSON" $ do
      it "decodes {accepted, event}" $ do
        let raw = LBS.pack "{\"accepted\":true,\"event\":{\"q\":\"shirt\"}}"
        case decode raw :: Maybe Types.AnalyticsEventResponse of
          Just resp -> do
            Types.aerAccepted resp `shouldBe` True
          Nothing -> expectationFailure "failed to decode AnalyticsEventResponse"
      it "defaults missing event to Null" $
        decode "{\"accepted\":false}"
          `shouldBe` Just
            ( Types.AnalyticsEventResponse
                { Types.aerAccepted = False,
                  Types.aerEvent = Null
                }
            )

    describe "analyticsEventOptionsParams URI rendering" $ do
      it "defaultAnalyticsEventOptions emits no params" $
        Types.analyticsEventOptionsParams Types.defaultAnalyticsEventOptions
          `shouldBe` []
      it "renders debug=true" $
        Types.analyticsEventOptionsParams
          Types.defaultAnalyticsEventOptions {Types.aeoDebug = Just True}
          `shouldBe` [("debug", Just "true")]

    describe "endpoint shape" $ do
      it "GETs /_application/analytics with no body (list all)" $ do
        let req = RequestsES8.getAnalyticsCollections Nothing
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics"]
        bhRequestBody req `shouldSatisfy` isNothing
      it "GETs /_application/analytics/<name> (single)" $ do
        let req = RequestsES8.getAnalyticsCollections (Just "clicks")
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics", "clicks"]
        bhRequestBody req `shouldSatisfy` isNothing
      it "PUTs /_application/analytics/<name> with an empty body" $ do
        let req = RequestsES8.putAnalyticsCollection "clicks"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics", "clicks"]
        bhRequestBody req `shouldSatisfy` isJust
      it "DELETEs /_application/analytics/<name>" $ do
        let req = RequestsES8.deleteAnalyticsCollection "clicks"
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics", "clicks"]
        bhRequestBody req `shouldSatisfy` isNothing
      it "POSTs .../event/<type> with a JSON body" $ do
        let payload = object ["q" .= ("shirt" :: Text)]
            req =
              RequestsES8.postAnalyticsEvent
                "clicks"
                Types.analyticsEventTypeSearchClick
                payload
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics", "clicks", "event", "search_click"]
        bhRequestBody req `shouldSatisfy` isJust
        getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
      it "postAnalyticsEventWith appends debug" $ do
        let payload = object ["q" .= ("shirt" :: Text)]
            req =
              RequestsES8.postAnalyticsEventWith
                Types.defaultAnalyticsEventOptions {Types.aeoDebug = Just True}
                "clicks"
                Types.analyticsEventTypePageView
                payload
        getRawEndpoint (bhRequestEndpoint req)
          `shouldBe` ["_application", "analytics", "clicks", "event", "page_view"]
        getRawEndpointQueries (bhRequestEndpoint req)
          `shouldBe` [("debug", Just "true")]

    describe "live integration (requires ES8+ backend)" $
      backendSpecific [ElasticSearch8] $ do
        it "round-trips a behavioral analytics collection via PUT then GET then DELETE" $
          withTestEnv $ do
            let name = Types.AnalyticsCollectionName "bloodhound-test-ba"
            _ <- tryPerformBHRequest $ RequestsES8.deleteAnalyticsCollection name
            putResp <- tryEsError (ClientES8.putAnalyticsCollection name)
            case putResp of
              Left e
                | errorStatus e == Just 403
                    || "privilege" `T.isInfixOf` T.toLower (errorMessage e) ->
                    liftIO $
                      pendingWith
                        "behavioral analytics requires manage_behavioral_analytics \
                        \privilege; skip on locked-down clusters"
              Left e ->
                liftIO $
                  expectationFailure $
                    "unexpected PUT error: " <> show e
              Right _ -> do
                cols <- ClientES8.getAnalyticsCollections (Just name)
                liftIO $ length cols `shouldBe` 1
                _ <- ClientES8.deleteAnalyticsCollection name
                pure ()