HistoryRetentionMock.hs

module Test.HistoryRetentionMock (spec) where

import Control.Monad.IO.Class (liftIO)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Text (Text)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
import Data.UUID qualified as UUID
import Data.Vector qualified as Vector
import Effectful (Eff, IOE, runEff, (:>))
import Effectful.Dispatch.Dynamic (interpret_)
import Kiroku.Store.Effect (Store (..))
import Kiroku.Store.HistoryRetention
import Kiroku.Store.Types (GlobalPosition (..))
import Test.Hspec

spec :: Spec
spec = describe "history retention mock" $ do
  it "dispatches every closed lease operation exactly once" $ do
    calls <- newIORef ([] :: [Text])
    actual <- runEff $ runMock calls $ do
      acquired <- acquireHistoryRetentionLease sampleRequest
      renewed <- renewHistoryRetentionLease sampleHandle sampleDuration
      released <- releaseHistoryRetentionLease sampleHandle
      inventory <- historyRetentionLeaseInventory sampleQuery
      pruned <- pruneHistoryRetentionLeases sampleTime
      pure (acquired, renewed, released, inventory, pruned)
    actual
      `shouldBe` ( sampleLease,
                   Right sampleLease,
                   HistoryRetentionReleased sampleLease,
                   Vector.singleton sampleLease,
                   HistoryRetentionPruneResult 2 3
                 )
    readIORef calls
      `shouldReturn` ["acquire", "renew", "release", "inventory", "prune"]

runMock :: (IOE :> es) => IORef [Text] -> Eff (Store : es) a -> Eff es a
runMock calls = interpret_ $ \case
  AcquireHistoryRetentionLease request -> do
    liftIO $ request `shouldBe` sampleRequest
    record calls "acquire"
    pure sampleLease
  RenewHistoryRetentionLease handle duration -> do
    liftIO $ (handle, duration) `shouldBe` (sampleHandle, sampleDuration)
    record calls "renew"
    pure (Right sampleLease)
  ReleaseHistoryRetentionLease handle -> do
    liftIO $ handle `shouldBe` sampleHandle
    record calls "release"
    pure (HistoryRetentionReleased sampleLease)
  GetHistoryRetentionLeaseInventory query -> do
    liftIO $ query `shouldBe` sampleQuery
    record calls "inventory"
    pure (Vector.singleton sampleLease)
  PruneHistoryRetentionLeases cutoff -> do
    liftIO $ cutoff `shouldBe` sampleTime
    record calls "prune"
    pure (HistoryRetentionPruneResult 2 3)
  _ -> error "unexpected Store operation in history retention mock"

record :: (IOE :> es) => IORef [Text] -> Text -> Eff es ()
record calls name = liftIO $ modifyIORef' calls (<> [name])

sampleRequest :: HistoryRetentionLeaseRequest
sampleRequest =
  HistoryRetentionLeaseRequest sampleOwner sampleReason sampleDuration

sampleHandle :: HistoryRetentionLeaseHandle
sampleHandle = HistoryRetentionLeaseHandle sampleId sampleOwner

sampleLease :: HistoryRetentionLease
sampleLease =
  HistoryRetentionLease
    sampleId
    sampleOwner
    sampleReason
    (GlobalPosition 17)
    sampleTime
    sampleTime
    sampleExpiry
    Nothing
    HistoryRetentionLeaseActive

sampleId :: HistoryRetentionLeaseId
sampleId = HistoryRetentionLeaseId UUID.nil

sampleOwner :: HistoryRetentionLeaseOwner
sampleOwner = either (error . show) (\value -> value) (mkHistoryRetentionLeaseOwner "mock-owner")

sampleReason :: HistoryRetentionLeaseReason
sampleReason = either (error . show) (\value -> value) (mkHistoryRetentionLeaseReason "mock-reason")

sampleDuration :: HistoryRetentionLeaseDuration
sampleDuration = either (error . show) (\value -> value) (mkHistoryRetentionLeaseDuration (secondsToDiffTime 60))

sampleQuery :: HistoryRetentionInventoryQuery
sampleQuery =
  HistoryRetentionInventoryQuery $
    either (error . show) (\value -> value) (mkHistoryRetentionInventoryLimit 10)

sampleTime :: UTCTime
sampleTime = UTCTime (fromGregorian 2026 8 13) 0

sampleExpiry :: UTCTime
sampleExpiry = UTCTime (fromGregorian 2026 8 13) (secondsToDiffTime 60)