InterpreterHooks.hs

-- | Tests for the interpreter-level event-data hooks installed via
-- 'Kiroku.Store.Settings.StoreSettings'.
--
-- Three concerns are covered (added across the plan's milestones):
--
--   * @enrichEvent@ fires on the append path before encoding, so an
--     appended event surfaces with the hook's mutation visible.
--   * @decodeHook@ fires on the read and subscription paths after
--     decoding, so both 'readAllForward' and a live 'subscribe' handler
--     see the hook's mutation.
--   * With both hooks 'Nothing' (the default), a round-trip is
--     byte-identical to the input — the no-op fast path introduces no
--     'pure'-wrapping artefact.
module Test.InterpreterHooks (spec) where

import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)
import Control.Lens ((&), (.~), (^.))
import Data.Aeson qualified as Aeson
import Data.Foldable (for_)
import Data.Generics.Labels ()
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.Vector qualified as V
import Kiroku.Store
import Test.Helpers (caughtUpEventHandler, makeEvent, waitForPublisher, waitForSubscriptionLive, waitWithTimeout, withTestStore, withTestStoreSettings)
import Test.Hspec

spec :: Spec
spec = describe "InterpreterHooks" $ do
  describe "enrichEvent" appendHookFiresSpec
  describe "decodeHook" readHookFiresSpec
  describe "no hooks" noHookNoEffectSpec

-- ---------------------------------------------------------------------------
-- enrichEvent
-- ---------------------------------------------------------------------------

appendHookFiresSpec :: Spec
appendHookFiresSpec = do
  it "applies enrichEvent to appended events surfaced through readStreamForward" $ do
    let marker = Aeson.object [("hook", Aeson.String "applied")]
        inject ed = pure $ ed & #metadata .~ Just marker
        tweak cs =
          cs
            & #storeSettings
              .~ defaultStoreSettings {enrichEvent = Just inject}
    withTestStoreSettings tweak $ \store -> do
      Right _ <-
        runStoreIO store $
          appendToStream
            (StreamName "hook-append-1")
            NoStream
            [makeEvent "X" (Aeson.object [("seed", Aeson.Number 1)])]
      evs <-
        runStoreIO store $
          readStreamForward (StreamName "hook-append-1") (StreamVersion 0) 10
      case evs of
        Right v
          | V.length v == 1 ->
              (V.head v ^. #metadata) `shouldBe` Just marker
        other -> expectationFailure ("unexpected read result: " <> show other)

  it "applies enrichEvent across appendMultiStream per-stream batches" $ do
    countRef <- newIORef (0 :: Int)
    let inject ed = do
          modifyIORef' countRef (+ 1)
          pure $ ed & #metadata .~ Just (Aeson.object [("multi", Aeson.Bool True)])
        tweak cs =
          cs
            & #storeSettings
              .~ defaultStoreSettings {enrichEvent = Just inject}
    withTestStoreSettings tweak $ \store -> do
      let ops =
            [ (StreamName "hook-multi-A", NoStream, [makeEvent "A1" (Aeson.object []), makeEvent "A2" (Aeson.object [])]),
              (StreamName "hook-multi-B", NoStream, [makeEvent "B1" (Aeson.object [])])
            ]
      Right _ <- runStoreIO store $ appendMultiStream ops
      n <- readIORef countRef
      n `shouldBe` 3
      Right vA <- runStoreIO store $ readStreamForward (StreamName "hook-multi-A") (StreamVersion 0) 10
      Right vB <- runStoreIO store $ readStreamForward (StreamName "hook-multi-B") (StreamVersion 0) 10
      for_ (V.toList vA <> V.toList vB) $ \re ->
        (re ^. #metadata) `shouldBe` Just (Aeson.object [("multi", Aeson.Bool True)])

-- ---------------------------------------------------------------------------
-- decodeHook
-- ---------------------------------------------------------------------------

readHookFiresSpec :: Spec
readHookFiresSpec = do
  it "retains the no-hook batch without evaluating its events" $ do
    batch <- decodeEvents defaultStoreSettings (V.replicate 100 (error "no-hook decoding traversed the vector"))
    case batch of
      UnchangedBatch events -> V.length events `shouldBe` 100
      TransformedBatch _ -> expectationFailure "default decoding allocated per-event outcomes"

  it "applies decodeHook to readAllForward results" $ do
    let marker = Aeson.object [("decoded", Aeson.String "yes")]
        inject re = pure $ Right (re & #metadata .~ Just marker)
        tweak cs =
          cs
            & #storeSettings
              .~ defaultStoreSettings {decodeHook = Just inject}
    withTestStoreSettings tweak $ \store -> do
      Right _ <-
        runStoreIO store $
          appendToStream
            (StreamName "hook-decode-1")
            NoStream
            [ makeEvent "E1" (Aeson.object []),
              makeEvent "E2" (Aeson.object []),
              makeEvent "E3" (Aeson.object [])
            ]
      Right v <-
        runStoreIO store $
          readAllForward (GlobalPosition 0) 10
      V.length v `shouldBe` 3
      for_ (V.toList v) $ \re ->
        (re ^. #metadata) `shouldBe` Just marker

  it "applies decodeHook to subscription handlers across catch-up and live phases" $ do
    caughtUp <- newEmptyMVar
    let marker = Aeson.object [("sub", Aeson.String "tagged")]
        inject re = pure $ Right (re & #metadata .~ Just marker)
        subName = SubscriptionName "hook-sub-1"
        tweak cs =
          cs
            & #storeSettings
              .~ defaultStoreSettings {decodeHook = Just inject}
            & #eventHandler .~ Just (caughtUpEventHandler subName caughtUp Nothing)
    withTestStoreSettings tweak $ \store -> do
      -- Pre-append one event so the worker's catch-up path runs
      -- before live mode kicks in.
      Right warm <-
        runStoreIO store $
          appendToStream
            (StreamName "hook-sub-stream-1")
            NoStream
            [makeEvent "warm" (Aeson.object [])]
      waitForPublisher store (warm ^. #globalPosition)

      seen <- newIORef ([] :: [Maybe Aeson.Value])
      done <- newEmptyMVar
      let handlerFn re = do
            modifyIORef' seen ((re ^. #metadata) :)
            n <- length <$> readIORef seen
            if n >= 2
              then Stop <$ tryPutMVar done ()
              else pure Continue
          config = defaultSubscriptionConfig subName AllStreams handlerFn
      sub <- subscribe store config
      waitForSubscriptionLive caughtUp
      -- Append a second event to land in live mode.
      Right _ <-
        runStoreIO store $
          appendToStream
            (StreamName "hook-sub-stream-2")
            NoStream
            [makeEvent "live" (Aeson.object [])]
      takeMVar done
      res <- waitWithTimeout 2_000_000 sub
      case res of
        Right (Right ()) -> pure ()
        other -> expectationFailure ("subscription did not finish cleanly: " <> show other)
      metas <- reverse <$> readIORef seen
      metas `shouldBe` [Just marker, Just marker]

-- ---------------------------------------------------------------------------
-- no-op fast path
-- ---------------------------------------------------------------------------

noHookNoEffectSpec :: Spec
noHookNoEffectSpec = around withTestStore $
  it "with defaultStoreSettings, a round-trip preserves payload and metadata exactly" $ \store -> do
    let originalMeta = Just (Aeson.object [("k", Aeson.String "v")])
        originalPayload = Aeson.object [("x", Aeson.Number 42), ("y", Aeson.String "z")]
        event = makeEvent "Identity" originalPayload & #metadata .~ originalMeta
    Right _ <-
      runStoreIO store $
        appendToStream (StreamName "no-hook-roundtrip") NoStream [event]
    Right v <-
      runStoreIO store $
        readStreamForward (StreamName "no-hook-roundtrip") (StreamVersion 0) 10
    V.length v `shouldBe` 1
    let re = V.head v
    (re ^. #payload) `shouldBe` originalPayload
    (re ^. #metadata) `shouldBe` originalMeta