diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,18 @@ ## Unreleased +## 0.1.2.0 - 2026-07-05 + +### Changed + +- Redis cache operations are now best-effort: lookup failures degrade to misses + and store failures are ignored. +- `openRedisCache` now stores entries without a Redis-side TTL by default. Use + `openRedisCacheWithTTL defaultRedisTTL` to restore the previous seven-day + expiry behavior. +- Refreshed internal `shikumi` and `shikumi-cache` bounds for the current package + set. + ## 0.1.1.0 - 2026-06-28 ### Changed diff --git a/shikumi-cache-redis.cabal b/shikumi-cache-redis.cabal --- a/shikumi-cache-redis.cabal +++ b/shikumi-cache-redis.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: shikumi-cache-redis -version: 0.1.1.0 +version: 0.1.2.0 synopsis: Redis-backed shikumi cache (EP-6) category: AI description: @@ -41,7 +41,7 @@ , bytestring , effectful , hedis - , shikumi-cache ^>=0.1.1.0 + , shikumi-cache ^>=0.1.2.0 , text ^>=2.1 test-suite shikumi-cache-redis-test @@ -51,17 +51,18 @@ main-is: Main.hs ghc-options: -threaded -with-rtsopts=-N build-depends: - , baikai >=0.2 && <0.3 + , baikai >=0.3 && <0.4 , base , bytestring , effectful , generic-lens , hedis , lens - , shikumi ^>=0.2.0.0 - , shikumi-cache ^>=0.1.1.0 - , shikumi-cache-redis ^>=0.1.1.0 + , shikumi ^>=0.3.0.0 + , shikumi-cache ^>=0.1.2.0 + , shikumi-cache-redis ^>=0.1.2.0 , tasty , tasty-hunit , text + , time , vector diff --git a/src/Shikumi/Cache/Backend/Redis.hs b/src/Shikumi/Cache/Backend/Redis.hs --- a/src/Shikumi/Cache/Backend/Redis.hs +++ b/src/Shikumi/Cache/Backend/Redis.hs @@ -4,10 +4,11 @@ -- Redis-backed cache is shared by every process that can reach the server, so a -- response computed on one machine is served to another. Entries live under the -- string key @shikumi:cache:\@ (the @shikumi:cache:@ prefix is operational --- namespacing, outside the content hash) and are written with @SETEX@ so Redis --- evicts stale entries after a configurable TTL. The value is the UTF-8 JSON of --- a 'CachedResponse'; the baikai 'Baikai.Response.Response' round-trip is the one --- from @shikumi-cache@ ("Shikumi.Cache.ResponseJSON"). +-- namespacing, outside the content hash). By default entries have no Redis-side +-- expiry; callers that want Redis to bound storage can opt into @SETEX@ with +-- 'openRedisCacheWithTTL'. The value is the UTF-8 JSON of a 'CachedResponse'; +-- the baikai 'Baikai.Response.Response' round-trip is the one from +-- @shikumi-cache@ ("Shikumi.Cache.ResponseJSON"). module Shikumi.Cache.Backend.Redis ( RedisCache, defaultRedisTTL, @@ -26,28 +27,36 @@ import Effectful (Eff, IOE, liftIO, (:>)) import Effectful.Dispatch.Dynamic (interpret) import Shikumi.Cache (Cache (..), CacheKey (unCacheKey)) +import Shikumi.Cache.Backend.Effort (bestEffortIO) --- | An open Redis-backed cache: a connection plus the TTL (seconds) applied to --- every stored entry. +-- | An open Redis-backed cache: a connection plus an optional server-side TTL +-- (seconds) applied to stored entries. data RedisCache = RedisCache { conn :: !R.Connection, - ttl :: !Integer + ttl :: !(Maybe Integer) } --- | The default entry TTL: 7 days (in seconds). +-- | The historical Redis storage TTL: 7 days (in seconds). It is no longer +-- applied by default; pass it to 'openRedisCacheWithTTL' to restore the old +-- Redis-side expiry behavior. defaultRedisTTL :: Integer defaultRedisTTL = 7 * 24 * 60 * 60 --- | Connect to Redis (verifying the connection eagerly via @checkedConnect@) with --- the 'defaultRedisTTL'. Throws 'R.ConnectError' if the server is unreachable. +-- | Connect to Redis (verifying the connection eagerly via @checkedConnect@) +-- with no Redis-side expiry. Throws 'R.ConnectError' if the server is +-- unreachable. openRedisCache :: R.ConnectInfo -> IO RedisCache -openRedisCache = openRedisCacheWithTTL defaultRedisTTL +openRedisCache ci = do + conn <- R.checkedConnect ci + pure (RedisCache conn Nothing) --- | As 'openRedisCache' but with an explicit per-entry TTL (seconds). +-- | As 'openRedisCache' but with an explicit Redis-side per-entry TTL (seconds). +-- This bounds Redis storage independently of the policy-layer 'CacheConfig' +-- expiry in @shikumi-cache@. openRedisCacheWithTTL :: Integer -> R.ConnectInfo -> IO RedisCache openRedisCacheWithTTL ttl ci = do conn <- R.checkedConnect ci - pure (RedisCache conn ttl) + pure (RedisCache conn (Just ttl)) -- | Close the Redis connection. closeRedisCache :: RedisCache -> IO () @@ -58,15 +67,21 @@ redisKey k = TE.encodeUtf8 ("shikumi:cache:" <> unCacheKey k) -- | Discharge the 'Cache' effect against Redis. A missing key, a Redis-level --- error, or a JSON decode failure all surface as a cache MISS ('Nothing'), so a --- transient hiccup or a stale-schema value is simply re-fetched. +-- error, thrown connection failure, or JSON decode failure all surface as a +-- cache MISS ('Nothing'), so a transient hiccup or stale-schema value is simply +-- re-fetched. Store failures are swallowed for the same best-effort posture. runCacheRedis :: (IOE :> es) => RedisCache -> Eff (Cache : es) a -> Eff es a runCacheRedis cache = interpret $ \_ -> \case - LookupCache k -> liftIO $ do + LookupCache k -> liftIO . bestEffortIO Nothing $ do r <- R.runRedis (conn cache) (R.get (redisKey k)) pure $ case r of Right (Just bs) -> decodeStrict' bs _ -> Nothing - StoreCache k v -> liftIO $ do - _ <- R.runRedis (conn cache) (R.setex (redisKey k) (ttl cache) (BL.toStrict (encode v))) + StoreCache k v -> liftIO . bestEffortIO () $ do + let bytes = BL.toStrict (encode v) + _ <- + R.runRedis (conn cache) $ + case ttl cache of + Just seconds -> () <$ R.setex (redisKey k) seconds bytes + Nothing -> () <$ R.set (redisKey k) bytes pure () diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,7 +6,8 @@ -- The test connects to the UNIX socket named by @REDIS_SOCKET@ (set by the dev -- shell; started by @just services@). When the variable is unset or no server is -- reachable, the suite __skips cleanly__ (prints a notice and exits 0) so CI --- without a Redis stays green — exactly the graceful-skip the plan requires. +-- without a Redis stays green, unless @SHIKUMI_REQUIRE_BACKENDS@ is set (CI sets +-- it), in which case the skip becomes a failure. module Main (main) where import Baikai (Context, Model, Options, Response, user, _Context, _Model, _Options, _Response) @@ -18,18 +19,34 @@ import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Text.Encoding qualified as TE +import Data.Time.Clock (UTCTime) import Data.Vector qualified as V import Database.Redis qualified as R import Effectful (Eff, IOE, liftIO, runEff, type (:>)) import Effectful.Dispatch.Dynamic (interpret) -import Shikumi.Cache (CacheKey (unCacheKey), cacheKey, cachedLLM) -import Shikumi.Cache.Backend.Redis (RedisCache, closeRedisCache, openRedisCache, runCacheRedis) +import Shikumi.Cache + ( CacheKey (unCacheKey), + CachedResponse (..), + cacheKey, + cachedLLM, + currentKeyVersion, + lookupCache, + storeCache, + ) +import Shikumi.Cache.Backend.Redis + ( RedisCache, + closeRedisCache, + openRedisCache, + openRedisCacheWithTTL, + runCacheRedis, + ) import Shikumi.Effect.Time (runTime) import Shikumi.LLM (LLM (..), complete) import System.Environment (lookupEnv) -import System.Exit (exitSuccess) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStrLn, stderr) import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.HUnit (testCase, (@?=)) +import Test.Tasty.HUnit (assertBool, testCase, (@?=)) fixModel :: Model fixModel = _Model & #modelId .~ "claude-sonnet-4-6" & #provider .~ "anthropic" @@ -43,6 +60,12 @@ stubResponse :: Response stubResponse = _Response +someTime :: UTCTime +someTime = read "2026-06-08 00:00:00 UTC" + +entry :: CachedResponse +entry = CachedResponse stubResponse someTime currentKeyVersion + -- | A counting stub interpreter of EP-1's @LLM@: every completion bumps a -- counter and returns a fixed response. runCountingLLM :: (IOE :> es) => IORef Int -> Response -> Eff (LLM : es) a -> Eff es a @@ -62,27 +85,45 @@ Left _ -> skip ("no Redis reachable at socket " <> sock) Right cache -> do clearKey ci - defaultMain (tests cache) + defaultMain (tests ci cache) closeRedisCache cache where skip reason = do - putStrLn ("[SKIP] shikumi-cache-redis: " <> reason) - exitSuccess + required <- lookupEnv "SHIKUMI_REQUIRE_BACKENDS" + if maybe False (`notElem` ["", "0"]) required + then do + hPutStrLn stderr ("[FAIL] shikumi-cache-redis: SHIKUMI_REQUIRE_BACKENDS is set but " <> reason) + exitFailure + else do + let banner = replicate 72 '=' + mapM_ + putStrLn + [ banner, + "== SKIPPED: shikumi-cache-redis test suite ran ZERO tests", + "== reason: " <> reason, + "== to run for real: `just services-up` inside `nix develop .#ghc9124`", + "== CI enforcement of this skip is owned by docs/masterplans/9-ci-and-shared-test-infrastructure.md", + banner + ] + exitSuccess -- | Delete any entry a previous run left for the fixed request, via a throwaway -- connection, so the MISS→HIT counter starts honest. clearKey :: R.ConnectInfo -> IO () -clearKey ci = do +clearKey ci = clearKeyFor ci (cacheKey fixModel fixCtx fixOpts) + +clearKeyFor :: R.ConnectInfo -> CacheKey -> IO () +clearKeyFor ci key = do conn <- R.checkedConnect ci - void $ R.runRedis conn (R.del (redisKeyFor (cacheKey fixModel fixCtx fixOpts) :| [])) + void $ R.runRedis conn (R.del (redisKeyFor key :| [])) R.disconnect conn -- | Rebuild the backend's operational key (the backend keeps it private). redisKeyFor :: CacheKey -> ByteString redisKeyFor k = TE.encodeUtf8 ("shikumi:cache:" <> unCacheKey k) -tests :: RedisCache -> TestTree -tests cache = +tests :: R.ConnectInfo -> RedisCache -> TestTree +tests ci cache = testGroup "shikumi-cache-redis" [ testCase "memoize: first request MISS (provider once), repeat is a Redis HIT" $ do @@ -102,5 +143,39 @@ runEff . runTime . runCacheRedis cache . runCountingLLM refB stubResponse . cachedLLM $ complete fixModel fixCtx fixOpts nB <- readIORef refB - nB @?= 0 + nB @?= 0, + testCase "a closed connection degrades to MISS / no-op" $ do + let key = cacheKey fixModel fixCtx (fixOpts & #temperature .~ Just 0.2) + clearKeyFor ci key + closed <- openRedisCache ci + closeRedisCache closed + got <- runEff . runCacheRedis closed $ lookupCache key + got @?= Nothing + runEff . runCacheRedis closed $ + storeCache key entry, + testCase "storage TTL knob: opt-in SETEX vs default no-expiry" $ do + let key = cacheKey fixModel fixCtx (fixOpts & #temperature .~ Just 0.3) + clearKeyFor ci key + ttlCache <- openRedisCacheWithTTL 60 ci + runEff . runCacheRedis ttlCache $ + storeCache key entry + ttlWithExpiry <- redisTTL ci key + closeRedisCache ttlCache + case ttlWithExpiry of + Right seconds -> assertBool ("SETEX should leave a positive TTL, got " <> show seconds) (seconds > 0) + Left err -> fail ("TTL lookup failed after SETEX: " <> show err) + clearKeyFor ci key + defaultCache <- openRedisCache ci + runEff . runCacheRedis defaultCache $ + storeCache key entry + ttlNoExpiry <- redisTTL ci key + closeRedisCache defaultCache + ttlNoExpiry @?= Right (-1) ] + +redisTTL :: R.ConnectInfo -> CacheKey -> IO (Either R.Reply Integer) +redisTTL ci key = do + conn <- R.checkedConnect ci + result <- R.runRedis conn (R.ttl (redisKeyFor key)) + R.disconnect conn + pure result