shikumi-cache-redis (empty) → 0.1.0.0

raw patch · 4 files changed

+255/−0 lines, 4 filesdep +aesondep +baikaidep +base

Dependencies added: aeson, baikai, base, bytestring, effectful, generic-lens, hedis, lens, shikumi, shikumi-cache, shikumi-cache-redis, tasty, tasty-hunit, text, vector

Files

CHANGELOG.md +10/−0
shikumi-cache-redis.cabal +67/−0
src/Shikumi/Cache/Backend/Redis.hs +72/−0
test/Main.hs +106/−0

+ CHANGELOG.md view

@@ -0,0 +1,10 @@+# Changelog++## Unreleased++## 0.1.0.0 - 2026-06-13++### Added++- Initial Hackage release of the Redis backend for shikumi-cache.+- Redis connection lifecycle helpers, configurable TTL support, and a cache interpreter for the shikumi cache effect.

+ shikumi-cache-redis.cabal view

@@ -0,0 +1,67 @@+cabal-version:   3.4+name:            shikumi-cache-redis+version:         0.1.0.0+synopsis:        Redis-backed shikumi cache (EP-6)+category:        AI+description:+  A Redis backend for shikumi's @Cache@ effect (EP-6), kept in a separate+  package so the heavy @hedis@ client and a running Redis server are only+  pulled in when actually used. Entries are stored under the string key+  @shikumi:cache:\<hex\>@ with a configurable TTL; the value is the UTF-8 JSON of+  a @CachedResponse@ (the @Response@ round-trip comes from @shikumi-cache@'s+  @Shikumi.Cache.ResponseJSON@).++license:         BSD-3-Clause+author:          Nadeem Bitar+maintainer:      nadeem@gmail.com+build-type:      Simple+extra-doc-files: CHANGELOG.md++common common-options+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+    -Wmissing-deriving-strategies++  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import:          common-options+  hs-source-dirs:  src+  exposed-modules: Shikumi.Cache.Backend.Redis+  build-depends:+    , aeson+    , base           >=4.20     && <5+    , bytestring+    , effectful+    , hedis+    , shikumi-cache  ^>=0.1.0.0+    , text           ^>=2.1++test-suite shikumi-cache-redis-test+  import:         common-options+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  ghc-options:    -threaded -with-rtsopts=-N+  build-depends:+    , baikai+    , base+    , bytestring+    , effectful+    , generic-lens+    , hedis+    , lens+    , shikumi              ^>=0.1.0.0+    , shikumi-cache        ^>=0.1.0.0+    , shikumi-cache-redis  ^>=0.1.0.0+    , tasty+    , tasty-hunit+    , text+    , vector

+ src/Shikumi/Cache/Backend/Redis.hs view

@@ -0,0 +1,72 @@+-- | The Redis cache backend (EP-6) — a server-backed, cross-machine store.+--+-- Unlike the in-memory (process-local) and SQLite (single-file) backends, a+-- 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").+module Shikumi.Cache.Backend.Redis+  ( RedisCache,+    defaultRedisTTL,+    openRedisCache,+    openRedisCacheWithTTL,+    closeRedisCache,+    runCacheRedis,+  )+where++import Data.Aeson (decodeStrict', encode)+import Data.ByteString (ByteString)+import Data.ByteString.Lazy qualified as BL+import Data.Text.Encoding qualified as TE+import Database.Redis qualified as R+import Effectful (Eff, IOE, liftIO, (:>))+import Effectful.Dispatch.Dynamic (interpret)+import Shikumi.Cache (Cache (..), CacheKey (unCacheKey))++-- | An open Redis-backed cache: a connection plus the TTL (seconds) applied to+-- every stored entry.+data RedisCache = RedisCache+  { redisConn :: !R.Connection,+    redisTTL :: !Integer+  }++-- | The default entry TTL: 7 days (in seconds).+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.+openRedisCache :: R.ConnectInfo -> IO RedisCache+openRedisCache = openRedisCacheWithTTL defaultRedisTTL++-- | As 'openRedisCache' but with an explicit per-entry TTL (seconds).+openRedisCacheWithTTL :: Integer -> R.ConnectInfo -> IO RedisCache+openRedisCacheWithTTL ttl ci = do+  conn <- R.checkedConnect ci+  pure (RedisCache conn ttl)++-- | Close the Redis connection.+closeRedisCache :: RedisCache -> IO ()+closeRedisCache = R.disconnect . redisConn++-- | The operational Redis key for a content-addressed 'CacheKey'.+redisKey :: CacheKey -> ByteString+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.+runCacheRedis :: (IOE :> es) => RedisCache -> Eff (Cache : es) a -> Eff es a+runCacheRedis cache = interpret $ \_ -> \case+  LookupCache k -> liftIO $ do+    r <- R.runRedis (redisConn cache) (R.get (redisKey k))+    pure $ case r of+      Right (Just bs) -> decodeStrict' bs+      _ -> Nothing+  StoreCache k v -> liftIO $ do+    _ <- R.runRedis (redisConn cache) (R.setex (redisKey k) (redisTTL cache) (BL.toStrict (encode v)))+    pure ()

+ test/Main.hs view

@@ -0,0 +1,106 @@+-- | EP-6 Redis backend acceptance. Round-trips a @CachedResponse@ through a live+-- Redis over the @cachedLLM@ memoizer + a counting stub provider: the first+-- request is a MISS (provider called once, entry stored), a subsequent request+-- is a HIT served from Redis (no further provider call).+--+-- 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.+module Main (main) where++import Baikai (Context, Model, Options, Response, user, _Context, _Model, _Options, _Response)+import Control.Exception (SomeException, try)+import Control.Lens ((&), (.~))+import Control.Monad (void)+import Data.ByteString (ByteString)+import Data.Generics.Labels ()+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text.Encoding qualified as TE+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.Effect.Time (runTime)+import Shikumi.LLM (LLM (..), complete)+import System.Environment (lookupEnv)+import System.Exit (exitSuccess)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++fixModel :: Model+fixModel = _Model & #modelId .~ "claude-sonnet-4-6" & #provider .~ "anthropic"++fixCtx :: Context+fixCtx = _Context & #systemPrompt .~ Just "You are helpful." & #messages .~ V.singleton (user "ping")++fixOpts :: Options+fixOpts = _Options & #temperature .~ Just 0.0 & #maxTokens .~ Just 1024++stubResponse :: Response+stubResponse = _Response++-- | 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+runCountingLLM ref resp = interpret $ \_ -> \case+  Complete {} -> liftIO (modifyIORef' ref (+ 1)) >> pure resp+  Stream {} -> pure []++main :: IO ()+main = do+  msock <- lookupEnv "REDIS_SOCKET"+  case msock of+    Nothing -> skip "REDIS_SOCKET is not set"+    Just sock -> do+      let ci = R.defaultConnectInfo {R.connectAddr = R.ConnectAddrUnixSocket sock}+      attempt <- try (openRedisCache ci) :: IO (Either SomeException RedisCache)+      case attempt of+        Left _ -> skip ("no Redis reachable at socket " <> sock)+        Right cache -> do+          clearKey ci+          defaultMain (tests cache)+          closeRedisCache cache+  where+    skip reason = do+      putStrLn ("[SKIP] shikumi-cache-redis: " <> reason)+      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+  conn <- R.checkedConnect ci+  void $ R.runRedis conn (R.del (redisKeyFor (cacheKey fixModel fixCtx fixOpts) :| []))+  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 =+  testGroup+    "shikumi-cache-redis"+    [ testCase "memoize: first request MISS (provider once), repeat is a Redis HIT" $ do+        -- Two identical requests in one run: provider hit exactly once.+        refA <- newIORef 0+        (r1, r2) <-+          runEff . runTime . runCacheRedis cache . runCountingLLM refA stubResponse . cachedLLM $ do+            a <- complete fixModel fixCtx fixOpts+            b <- complete fixModel fixCtx fixOpts+            pure (a, b)+        nA <- readIORef refA+        nA @?= 1+        r1 @?= r2+        -- A fresh run (fresh counter) now finds the entry already in Redis → HIT.+        refB <- newIORef 0+        _ <-+          runEff . runTime . runCacheRedis cache . runCountingLLM refB stubResponse . cachedLLM $+            complete fixModel fixCtx fixOpts+        nB <- readIORef refB+        nB @?= 0+    ]