packages feed

shikumi-cache-redis 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+140/−37 lines, 4 filesdep +timedep ~baikaidep ~shikumidep ~shikumi-cachePVP ok

version bump matches the API change (PVP)

Dependencies added: time

Dependency ranges changed: baikai, shikumi, shikumi-cache, shikumi-cache-redis

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -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
shikumi-cache-redis.cabal view
@@ -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
src/Shikumi/Cache/Backend/Redis.hs view
@@ -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:\<hex\>@ (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 ()
test/Main.hs view
@@ -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