shikumi-cache 0.1.2.3 → 0.2.0.0

raw patch · 6 files changed

+209/−41 lines, 6 filesdep ~baikaidep ~shikumidep ~shikumi-cachePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: baikai, shikumi, shikumi-cache

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• shikumi-cache.cabal +6/−6
• src/Shikumi/Cache.hs +28/−19
• src/Shikumi/Cache/Key.hs +4/−2
• src/Shikumi/Cache/ResponseJSON.hs +2/−1
• test/Main.hs +157/−13

@@ -2,6 +2,18 @@  ## Unreleased +## 0.2.0.0 — 2026-09-08++- Raise the internal `shikumi` bound to `^>=0.4.0.0` for the breaking core release.++- Clear provider-call evidence on every cache hit, including the memory backend, so logical traces do not reuse a previous crossing as new evidence.++- Bypass memoizer reads and writes for any evidence request, including defaults and warm entries. Apply request defaults before caching so keys reflect effective options. No cache format or public signature change.++- Validate continuation before cache lookup. Both memoizers now require `Error ShikumiError`; this public constraint change requires a PVP major review at release.++- Upgrade the dependency on `mori://shinzui/baikai/packages/baikai` to `>=0.7.0.0 && <0.8`. Preserve cost basis and usage availability in cached responses while accepting legacy JSON without those fields. Include explicit inference speed in cache keys while preserving keys for requests without a speed preference.+ ## 0.1.2.3 — 2026-08-29  ### Changed

@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            shikumi-cache-version:         0.1.2.3+version:         0.2.0.0 synopsis:        Content-addressed response caching for shikumi (EP-6) category:        AI description:@@ -45,7 +45,7 @@    build-depends:     , aeson          >=2.2      && <2.3-    , baikai         >=0.6      && <0.7+    , baikai         >=0.7.0.0  && <0.8     , base           >=4.20     && <5     , blake3         >=0.3      && <0.4     , bytestring     >=0.11     && <0.13@@ -55,7 +55,7 @@     , generic-lens   >=2.2      && <2.4     , lens           ^>=5.3     , scientific     >=0.3      && <0.4-    , shikumi        ^>=0.3.0.0+    , shikumi        ^>=0.4.0.0     , stm            >=2.5      && <2.6     , text           ^>=2.1     , time           >=1.12     && <1.17@@ -69,7 +69,7 @@   ghc-options:    -threaded -with-rtsopts=-N   build-depends:     , aeson-    , baikai         >=0.6      && <0.7+    , baikai         >=0.7.0.0  && <0.8     , base     , bytestring     , containers@@ -80,8 +80,8 @@     , generic-lens     , lens     , process-    , shikumi        ^>=0.3.0.0-    , shikumi-cache  ^>=0.1.2.0+    , shikumi        ^>=0.4.0.0+    , shikumi-cache  ^>=0.2.0.0     , stm     , tasty     , tasty-hunit

@@ -30,18 +30,21 @@ where  import Baikai (Response, StopReason (ErrorReason))-import Control.Lens ((^.))+import Control.Lens ((&), (.~), (^.)) import Control.Monad (when) import Data.Generics.Labels ()-import Data.Maybe (isNothing)+import Data.Maybe (isJust, isNothing) import Data.Time.Clock (NominalDiffTime, diffUTCTime) import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, (:>)) import Effectful.Dispatch.Dynamic (interpose, passthrough, send)+import Effectful.Error.Static (Error, throwError) import GHC.Generics (Generic) import Shikumi.Cache.Key (CacheKey (..), cacheKey, currentKeyVersion) import Shikumi.Cache.Types (CachedResponse (..)) import Shikumi.Effect.Time (Time, getCurrentTime)+import Shikumi.Error (ShikumiError) import Shikumi.LLM (LLM (..), complete)+import Shikumi.LLM.Continuation (validateRequestContinuation)  -- | The cache storage effect: look an entry up by key, or store one. data Cache :: Effect where@@ -85,9 +88,11 @@ -- are never cached. Under concurrent identical requests both callers may miss -- and call the provider; this accepted check-then-act race is harmless because -- stores are idempotent upserts keyed by content. The streaming op is passed--- through unchanged — streams are not cached.+-- through unchanged — streams are not cached. Any evidence request bypasses+-- both reads and writes, since cached responses cannot establish a new provider+-- crossing. Compose defaults before this memoizer in request execution order. cachedLLM ::-  (Cache :> es, LLM :> es, Time :> es) =>+  (Cache :> es, LLM :> es, Time :> es, Error ShikumiError :> es) =>   Eff es a ->   Eff es a cachedLLM = cachedLLMWith defaultCacheConfig@@ -95,26 +100,30 @@ -- | A configured variant of 'cachedLLM'. See 'CacheConfig' for the shared TTL -- policy. cachedLLMWith ::-  (Cache :> es, LLM :> es, Time :> es) =>+  (Cache :> es, LLM :> es, Time :> es, Error ShikumiError :> es) =>   CacheConfig ->   Eff es a ->   Eff es a cachedLLMWith cfg = interpose $ \env -> \case   Complete model ctx opts -> do-    let key = cacheKey model ctx opts-    hit <- lookupCache key-    now <- getCurrentTime-    case hit of-      Just cr-        | keyVersion cr == currentKeyVersion,-          fresh (entryTTL cfg) now (storedAt cr) ->-            pure (response cr)-      _ -> do-        resp <- complete model ctx opts-        stored <- getCurrentTime-        when (cacheable resp) $-          storeCache key (CachedResponse resp stored currentKeyVersion)-        pure resp+    either throwError pure (validateRequestContinuation model ctx opts)+    if isJust (opts ^. #evidence)+      then complete model ctx opts+      else do+        let key = cacheKey model ctx opts+        hit <- lookupCache key+        now <- getCurrentTime+        case hit of+          Just cr+            | keyVersion cr == currentKeyVersion,+              fresh (entryTTL cfg) now (storedAt cr) ->+                pure (response cr & #evidence .~ Nothing)+          _ -> do+            resp <- complete model ctx opts+            stored <- getCurrentTime+            when (cacheable resp) $+              storeCache key (CachedResponse resp stored currentKeyVersion)+            pure resp   other -> passthrough env other   where     fresh Nothing _ _ = True

@@ -83,10 +83,11 @@ -- @api, baseUrl, compat, maxTokens, messages, model, modelHeaders, -- optionsHeaders, provider, responseFormat, systemPrompt, temperature, -- thinking, toolChoice, tools, version@. 'canonicalJSON' sorts the keys, so the--- listing order here is irrelevant.+-- listing order here is irrelevant. Explicit inference speed adds @speed@;+-- an absent preference preserves the existing key encoding. requestToCanonicalValueVersioned :: Text -> Model -> Context -> Options -> Value requestToCanonicalValueVersioned version m ctx opts =-  object+  object $     [ "version" .= version,       "model" .= (m ^. #modelId),       "provider" .= (m ^. #provider),@@ -104,6 +105,7 @@       "thinking" .= toJSON (opts ^. #thinking),       "responseFormat" .= toJSON (opts ^. #responseFormat)     ]+      <> maybe [] (\speed -> ["speed" .= speed]) (opts ^. #speed)   where     -- Normalize the Double through Scientific so two requests that are == in     -- temperature serialize identically regardless of how the Double was built.

@@ -59,6 +59,7 @@     genericParseJSON,     object,     withObject,+    (.!=),     (.:),     (.:?),     (.=),@@ -93,7 +94,7 @@  instance FromJSON Cost where   parseJSON = withObject "Cost" $ \o ->-    Cost <$> ratField o "usd" <*> o .: "breakdown"+    Cost <$> ratField o "usd" <*> o .: "breakdown" <*> o .:? "basis" .!= mempty  instance FromJSON AssistantPayload where   parseJSON = genericParseJSON defaultOptions

@@ -27,12 +27,20 @@     user,     userAt,   )+import Baikai qualified as B+import Baikai.Cost qualified as BC+import Baikai.Evidence qualified as E+import Baikai.Speed (Speed (..))+import Baikai.ThinkingLevel (ThinkingLevel (..))+import Baikai.Usage qualified as BU import Control.Exception (bracket)-import Control.Lens ((&), (.~))-import Data.Aeson (object, toJSON, (.=))+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Result (..), Value (..), eitherDecode, encode, fromJSON, object, toJSON, (.=))+import Data.Aeson.KeyMap qualified as KM import Data.Generics.Labels () import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.Map.Strict qualified as Map+import Data.Set qualified as Set import Data.Text qualified as T import Data.Time.Clock (UTCTime) import Data.Vector qualified as V@@ -41,6 +49,7 @@ import Effectful (Eff, IOE, liftIO, runEff, type (:>)) import Effectful.Concurrent (runConcurrent) import Effectful.Dispatch.Dynamic (interpret)+import Effectful.Error.Static (runErrorNoCallStack) import Shikumi.Cache   ( CacheKey (..),     CachedResponse (..),@@ -56,15 +65,20 @@ import Shikumi.Cache.Backend.Memory (newMemoryCache, runCacheMemory) import Shikumi.Cache.Backend.SQLite (runCacheSQLite, withSQLiteCache) import Shikumi.Cache.Key (canonicalJSON, requestToCanonicalValueVersioned, stripMessageTimestamps)+import Shikumi.Cache.ResponseJSON () import Shikumi.Effect.Time (runTime)+import Shikumi.Error (ShikumiError (..)) import Shikumi.LLM (LLM (..), complete)+import Shikumi.LLM.Continuation (contextIdentity, requestOrigin, stampContinuation)+import Shikumi.LLM.Defaults+import Shikumi.Routing (routeLLM, runRouting) import System.Environment (getEnvironment, getExecutablePath, lookupEnv) import System.Exit (ExitCode (ExitSuccess), exitFailure, exitSuccess) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) import System.Process (CreateProcess (env), proc, readCreateProcessWithExitCode) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  -- --------------------------------------------------------------------------- -- Fixtures@@ -126,7 +140,8 @@       defaultMain $         testGroup           "shikumi-cache"-          [ keyTests,+          [ defaultsTests,+            keyTests,             memoryTests,             sqliteTests,             memoizeTests,@@ -171,6 +186,10 @@         assertBool           "temperature change must change the key"           (cacheKey fixModel fixCtx fixOpts /= cacheKey fixModel fixCtx (fixOpts & #temperature .~ Just 0.7)),+      testCase "speed preference changes the key" $ do+        let standard = cacheKey fixModel fixCtx (fixOpts & #speed .~ Just SpeedStandard)+            fast = cacheKey fixModel fixCtx (fixOpts & #speed .~ Just SpeedFast)+        assertBool "explicit speed must be part of the key" (standard /= fast && fast /= cacheKey fixModel fixCtx fixOpts),       testCase "baseUrl changes the key" $         assertBool           "endpoint routing must be part of the key"@@ -241,6 +260,19 @@             withSQLiteCache file $ \c ->               runEff . runCacheSQLite c $ (storeCache restartKey restartEntry >> lookupCache restartKey)           got @?= Just restartEntry,+      testCase "billing metadata survives response JSON" $ do+        let response =+              emptyResponse+                & #message . #usage . #cost . #basis .~ BC.CostBasis (Set.singleton BC.StandardTokenRates) (Set.singleton BC.CacheWriteUsageNotReported)+                & #message . #usage . #availability .~ Just (BU.UsageAvailability (Set.singleton BU.CacheWriteUsage) False (Set.singleton (BU.BillingSpeed "fast")))+        eitherDecode (encode response) @?= Right response,+      testCase "legacy usage JSON without billing metadata still decodes" $ do+        let legacy = case toJSON BU.zeroUsage of+              Object fields -> Object (KM.delete "availability" (KM.mapWithKey (\k v -> if k == "cost" then stripBasis v else v) fields))+              other -> other+            stripBasis (Object fields) = Object (KM.delete "basis" fields)+            stripBasis other = other+        fromJSON legacy @?= Success BU.zeroUsage,       testCase "an absent key returns Nothing" $         withSystemTempDirectory "shikumi-sqlite" $ \dir -> do           let file = dir </> "cache.db"@@ -300,11 +332,36 @@ memoizeTests =   testGroup     "memoize"-    [ testCase "same request twice contacts the provider once with equal outputs" $ do+    [ testCase "routing then guarded cache preserves a compatible warm hit" $ do         tv <- newMemoryCache         ref <- newIORef 0-        (r1, r2) <--          runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ do+        let model = B.mkModel B.AnthropicMessages "test" "https://provider.example"+            ctx = fixCtx & #messages .~ V.fromList [B.user "ping", B.AssistantMessage (stubResponse ^. #message & #content .~ V.singleton (B.AssistantThinking (B.ThinkingContent "" (Just "signature") False Nothing)))]+            opts = stampContinuation (requestOrigin model) (Just (contextIdentity ctx)) fixOpts+        result <- runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runRouting model . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM . routeLLM $ do+          a <- complete emptyModel ctx opts+          b <- complete emptyModel ctx opts+          pure (a == b)+        result @?= Right True+        readIORef ref >>= (@?= 1),+      testCase "warm cache cannot bypass changed continuation origin or prefix" $ do+        tv <- newMemoryCache+        ref <- newIORef 0+        let expected = fixModel & #api .~ B.AnthropicMessages & #baseUrl .~ "https://original.example"+            actual = expected & #modelId .~ "different"+            opts = stampContinuation (requestOrigin expected) (Just (contextIdentity fixCtx)) fixOpts+            key = cacheKey actual fixCtx opts+        runEff . runConcurrent . runCacheMemory tv $ storeCache key (CachedResponse stubResponse someTime currentKeyVersion)+        result <- runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ complete actual fixCtx opts+        case result of+          Left (ValidationFailure _) -> pure ()+          _ -> assertFailure "cache bypassed continuation guard"+        readIORef ref >>= (@?= 0),+      testCase "same request twice contacts the provider once with equal outputs" $ do+        tv <- newMemoryCache+        ref <- newIORef 0+        Right (r1, r2) <-+          runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ do             a <- complete fixModel fixCtx fixOpts             b <- complete fixModel fixCtx fixOpts             pure (a, b)@@ -315,7 +372,7 @@         tv <- newMemoryCache         ref <- newIORef 0         _ <--          runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ do+          runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ do             _ <- complete fixModel fixCtx fixOpts             complete fixModel fixCtx (fixOpts & #temperature .~ Just 0.7)         n <- readIORef ref@@ -325,7 +382,7 @@         ref <- newIORef 0         let errResp = stubResponse & #message . #stopReason .~ ErrorReason         _ <--          runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref errResp . cachedLLM $ do+          runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref errResp . cachedLLM $ do             _ <- complete fixModel fixCtx fixOpts             complete fixModel fixCtx fixOpts         n <- readIORef ref@@ -338,10 +395,10 @@         runEff . runConcurrent . runCacheMemory tv $           storeCache key (CachedResponse stubResponse someTime currentKeyVersion)         _ <--          runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLMWith cfg $+          runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLMWith cfg $             complete fixModel fixCtx fixOpts         _ <--          runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLMWith cfg $+          runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLMWith cfg $             complete fixModel fixCtx fixOpts         n <- readIORef ref         n @?= 1@@ -356,7 +413,7 @@         ref <- newIORef 0         let key = cacheKey fixModel fixCtx fixOpts         runEff . runConcurrent . runCacheMemory tv $ storeCache key (CachedResponse stubResponse someTime currentKeyVersion)-        _ <- runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ complete fixModel fixCtx fixOpts+        _ <- runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ complete fixModel fixCtx fixOpts         n <- readIORef ref         n @?= 0,       testCase "an entry with a foreign keyVersion is ignored (MISS, provider called)" $ do@@ -364,7 +421,7 @@         ref <- newIORef 0         let key = cacheKey fixModel fixCtx fixOpts         runEff . runConcurrent . runCacheMemory tv $ storeCache key (CachedResponse stubResponse someTime "shikumi-cache/v0")-        _ <- runEff . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ complete fixModel fixCtx fixOpts+        _ <- runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runTime . runCacheMemory tv . runCountingLLM ref stubResponse . cachedLLM $ complete fixModel fixCtx fixOpts         n <- readIORef ref         n @?= 1,       testCase "bumping the namespace version changes the hashed bytes" $@@ -373,4 +430,91 @@           ( canonicalJSON (requestToCanonicalValueVersioned currentKeyVersion fixModel fixCtx fixOpts)               /= canonicalJSON (requestToCanonicalValueVersioned "shikumi-cache/v3" fixModel fixCtx fixOpts)           )+    ]++defaultsTests :: TestTree+defaultsTests =+  testGroup+    "defaults and cache ordering"+    [ testCase "empty and equivalent explicit defaults have identical cache bytes" $ do+        let d = emptyRequestDefaults {defaultSpeed = Just SpeedFast, defaultThinking = Just ThinkingHigh}+            explicit = fixOpts & #speed .~ Just SpeedFast & #thinking .~ Just ThinkingHigh+        cacheKey fixModel fixCtx (applyRequestDefaults emptyRequestDefaults fixOpts) @?= cacheKey fixModel fixCtx fixOpts+        cacheKey fixModel fixCtx (applyRequestDefaults d fixOpts) @?= cacheKey fixModel fixCtx explicit,+      testCase "correct order separates effective speeds and reasoning then reuses equal options" $ do+        tv <- newMemoryCache+        ref <- newIORef 0+        let fast = emptyRequestDefaults {defaultSpeed = Just SpeedFast}+            standard = emptyRequestDefaults {defaultSpeed = Just SpeedStandard}+            thinking = fast {defaultThinking = Just ThinkingHigh}+        r <- runEff+          . runErrorNoCallStack @ShikumiError+          . runConcurrent+          . runTime+          . runRouting fixModel+          . runCacheMemory tv+          . runCountingLLM ref stubResponse+          . cachedLLM+          $ do+            _ <- withRequestDefaults fast . routeLLM $ complete emptyModel fixCtx fixOpts+            _ <- withRequestDefaults standard . routeLLM $ complete emptyModel fixCtx fixOpts+            _ <- withRequestDefaults thinking . routeLLM $ complete emptyModel fixCtx fixOpts+            _ <- withRequestDefaults fast . routeLLM $ complete emptyModel fixCtx (fixOpts & #thinking .~ Just ThinkingHigh)+            pure ()+        r @?= Right ()+        readIORef ref >>= (@?= 3),+      testCase "misplaced cache masks changed defaults (documented counterexample)" $ do+        tv <- newMemoryCache+        ref <- newIORef 0+        let run speed =+              runEff+                . runErrorNoCallStack @ShikumiError+                . runConcurrent+                . runTime+                . runCacheMemory tv+                . runCountingLLM ref stubResponse+                . withRequestDefaults (emptyRequestDefaults {defaultSpeed = Just speed})+                . cachedLLM+                $ complete fixModel fixCtx fixOpts+        _ <- run SpeedFast+        _ <- run SpeedStandard+        readIORef ref >>= (@?= 1),+      testCase "direct and default strict evidence bypass warm reads and writes" $ do+        tv <- newMemoryCache+        ref <- newIORef 0+        let evidence = (E.evidenceRequest "strict") {E.strictness = E.EvidenceRequired E.EvidenceFullyObserved}+            opts = fixOpts & #evidence .~ Just evidence+            key = cacheKey fixModel fixCtx opts+            entry = CachedResponse stubResponse someTime currentKeyVersion+            d = emptyRequestDefaults {defaultEvidence = Just evidence}+        runEff . runConcurrent . runCacheMemory tv $ storeCache key entry+        r <- runEff+          . runErrorNoCallStack @ShikumiError+          . runConcurrent+          . runTime+          . runCacheMemory tv+          . runCountingLLM ref stubResponse+          . cachedLLM+          $ do+            _ <- complete fixModel fixCtx opts+            _ <- withRequestDefaults d $ complete fixModel fixCtx fixOpts+            pure ()+        r @?= Right ()+        readIORef ref >>= (@?= 2)+        -- A write would replace the old timestamp even if the response is equal.+        got <- runEff . runConcurrent . runCacheMemory tv $ lookupCache key+        got @?= Just entry+        freshCache <- newMemoryCache+        _ <-+          runEff+            . runErrorNoCallStack @ShikumiError+            . runConcurrent+            . runTime+            . runCacheMemory freshCache+            . runCountingLLM ref stubResponse+            . cachedLLM+            . withRequestDefaults d+            $ complete fixModel fixCtx fixOpts+        absent <- runEff . runConcurrent . runCacheMemory freshCache $ lookupCache key+        absent @?= Nothing     ]