packages feed

shikumi-cache-postgres 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+97/−35 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-postgres

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -2,6 +2,17 @@  ## Unreleased +## 0.1.2.0 - 2026-07-05++### Changed++- Postgres cache operations are now best-effort: lookup failures degrade to+  misses and store failures are ignored.+- Failed schema creation now releases the connection, and accidental use after+  `closePostgresCache` degrades safely.+- Refreshed internal `shikumi` and `shikumi-cache` bounds for the current package+  set.+ ## 0.1.1.0 - 2026-06-28  ### Changed
shikumi-cache-postgres.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            shikumi-cache-postgres-version:         0.1.1.0+version:         0.1.2.0 synopsis:        Postgres-backed shikumi cache (EP-6) category:        AI description:@@ -42,7 +42,7 @@     , base           >=4.20     && <5     , effectful     , hasql-    , shikumi-cache  ^>=0.1.1.0+    , shikumi-cache  ^>=0.1.2.0     , text           ^>=2.1  test-suite shikumi-cache-postgres-test@@ -52,16 +52,17 @@   main-is:        Main.hs   ghc-options:    -threaded -with-rtsopts=-N   build-depends:-    , baikai                  >=0.2      && <0.3+    , baikai                  >=0.3      && <0.4     , base     , effectful     , ephemeral-pg     , generic-lens     , lens-    , shikumi                 ^>=0.2.0.0-    , shikumi-cache           ^>=0.1.1.0-    , shikumi-cache-postgres  ^>=0.1.1.0+    , shikumi                 ^>=0.3.0.0+    , shikumi-cache           ^>=0.1.2.0+    , shikumi-cache-postgres  ^>=0.1.2.0     , tasty     , tasty-hunit     , text+    , time     , vector
src/Shikumi/Cache/Backend/Postgres.hs view
@@ -3,8 +3,9 @@ -- -- Like the Redis backend it is shared by every process that can reach the -- server, but it persists entries in a @jsonb@ column rather than an evicting--- key-value store, so entries live until explicitly removed. The value column--- holds the JSON of a 'CachedResponse' (the baikai 'Baikai.Response.Response'+-- key-value store, so entries live until explicitly removed or the policy layer+-- treats them as expired via 'Shikumi.Cache.CacheConfig'. The value column holds+-- the JSON of a 'CachedResponse' (the baikai 'Baikai.Response.Response' -- round-trip is @shikumi-cache@'s "Shikumi.Cache.ResponseJSON"). Access goes -- through @hasql@; the single 'Connection' is guarded by an 'MVar' so the -- 'Cache' effect's lookups and stores are serialized.@@ -16,7 +17,7 @@   ) where -import Control.Concurrent.MVar (MVar, newMVar, withMVar)+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, withMVar) import Control.Exception (throwIO) import Data.Aeson (Result (Error, Success), Value, fromJSON, toJSON) import Data.Functor.Contravariant ((>$<))@@ -30,11 +31,14 @@ import Hasql.Encoders qualified as E import Hasql.Session (statement) import Hasql.Statement (Statement, preparable, unpreparable)-import Shikumi.Cache (Cache (..), CacheKey (unCacheKey), CachedResponse)+import Shikumi.Cache (Cache (..), CacheKey (unCacheKey))+import Shikumi.Cache.Backend.Effort (bestEffortIO)  -- | An open Postgres-backed cache: a single connection behind an 'MVar' (hasql--- connections are not safe for concurrent use), with the schema ensured at open.-newtype PostgresCache = PostgresCache {conn :: MVar Connection}+-- connections are not safe for concurrent use), with the schema ensured at+-- open. The connection becomes 'Nothing' after 'closePostgresCache' so accidental+-- use-after-close degrades without touching a released libpq pointer.+newtype PostgresCache = PostgresCache (MVar (Maybe Connection))  -- | Connect using the given hasql settings (e.g. @EphemeralPg.connectionSettings@ -- for tests, or @Hasql.Connection.Settings@ builders in production), ensuring the@@ -47,28 +51,39 @@     Right conn -> do       r <- Connection.use conn (statement () createTableStmt)       case r of-        Left e -> throwIO (userError ("shikumi-cache-postgres: schema creation failed: " <> show e))-        Right () -> PostgresCache <$> newMVar conn+        Left e -> do+          Connection.release conn+          throwIO (userError ("shikumi-cache-postgres: schema creation failed: " <> show e))+        Right () -> PostgresCache <$> newMVar (Just conn)  -- | Release the connection. closePostgresCache :: PostgresCache -> IO ()-closePostgresCache (PostgresCache mv) = withMVar mv Connection.release+closePostgresCache (PostgresCache mv) =+  modifyMVar_ mv $ \case+    Nothing -> pure Nothing+    Just conn -> do+      Connection.release conn+      pure Nothing  -- | Discharge the 'Cache' effect against Postgres. A missing row, a session -- error, or a JSON decode failure all surface as a MISS ('Nothing'); a store -- error is swallowed (best-effort caching — the next call simply re-fetches). runCachePostgres :: (IOE :> es) => PostgresCache -> Eff (Cache : es) a -> Eff es a runCachePostgres (PostgresCache mv) = interpret $ \_ -> \case-  LookupCache k -> liftIO $ do-    r <- withMVar mv (\conn -> Connection.use conn (statement (unCacheKey k) lookupStmt))-    pure $ case r of-      Right (Just v) -> case fromJSON v of-        Success cr -> Just cr-        Error _ -> Nothing-      _ -> Nothing-  StoreCache k v -> liftIO $ do-    _ <- withMVar mv (\conn -> Connection.use conn (statement (unCacheKey k, toJSON v) storeStmt))-    pure ()+  LookupCache k -> liftIO . bestEffortIO Nothing . withMVar mv $ \case+    Nothing -> pure Nothing+    Just conn -> do+      r <- Connection.use conn (statement (unCacheKey k) lookupStmt)+      pure $ case r of+        Right (Just v) -> case fromJSON v of+          Success cr -> Just cr+          Error _ -> Nothing+        _ -> Nothing+  StoreCache k v -> liftIO . bestEffortIO () . withMVar mv $ \case+    Nothing -> pure ()+    Just conn -> do+      _ <- Connection.use conn (statement (unCacheKey k, toJSON v) storeStmt)+      pure ()  -- | @CREATE TABLE IF NOT EXISTS@ (unpreparable — it is a utility statement). createTableStmt :: Statement () ()
test/Main.hs view
@@ -6,7 +6,9 @@ -- The database is a throwaway instance started by @ephemeral-pg@ (its own -- @initdb@/@postgres@ over a private socket), so the test is hermetic and needs -- no external server. If the cluster cannot be started (e.g. no postgres binary--- on PATH), the suite __skips cleanly__ (prints a notice and exits 0).+-- on PATH), the suite __skips cleanly__ (prints a notice and exits 0), 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)@@ -15,15 +17,18 @@ import Data.Generics.Labels () import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.Text qualified as T+import Data.Time.Clock (UTCTime) import Data.Vector qualified as V import Effectful (Eff, IOE, liftIO, runEff, type (:>)) import Effectful.Dispatch.Dynamic (interpret) import EphemeralPg qualified as Pg-import Shikumi.Cache (cacheKey, cachedLLM)+import Shikumi.Cache (CachedResponse (..), cacheKey, cachedLLM, currentKeyVersion, lookupCache, storeCache) import Shikumi.Cache.Backend.Postgres (PostgresCache, closePostgresCache, openPostgresCache, runCachePostgres) import Shikumi.Effect.Time (runTime) import Shikumi.LLM (LLM (..), complete)-import System.Exit (exitSuccess)+import System.Environment (lookupEnv)+import System.Exit (exitFailure, exitSuccess)+import System.IO (hPutStrLn, stderr) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) @@ -39,6 +44,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@@ -50,18 +61,35 @@ main = do   started <- Pg.start Pg.defaultConfig   case started of-    Left err -> do-      putStrLn ("[SKIP] shikumi-cache-postgres: " <> T.unpack (Pg.renderStartError err))-      exitSuccess+    Left err -> skip (T.unpack (Pg.renderStartError err))     Right db -> do       cache <- openPostgresCache (Pg.connectionSettings db)-      defaultMain (tests cache)+      defaultMain (tests (openPostgresCache (Pg.connectionSettings db)) cache)         `finally` (closePostgresCache cache >> Pg.stop db)+  where+    skip reason = do+      required <- lookupEnv "SHIKUMI_REQUIRE_BACKENDS"+      if maybe False (`notElem` ["", "0"]) required+        then do+          hPutStrLn stderr ("[FAIL] shikumi-cache-postgres: SHIKUMI_REQUIRE_BACKENDS is set but ephemeral-pg failed to start: " <> reason)+          exitFailure+        else do+          let banner = replicate 72 '='+          mapM_+            putStrLn+            [ banner,+              "== SKIPPED: shikumi-cache-postgres test suite ran ZERO tests",+              "== reason: " <> reason,+              "== to run for real: the dev shell provides the postgres binaries ephemeral-pg needs",+              "== CI enforcement of this skip is owned by docs/masterplans/9-ci-and-shared-test-infrastructure.md",+              banner+            ]+          exitSuccess  -- Keep a reference to `cacheKey` so the import is exercised even though the -- backend computes keys internally (documents the integration-point-#7 reuse).-tests :: PostgresCache -> TestTree-tests cache =+tests :: IO PostgresCache -> PostgresCache -> TestTree+tests openCache cache =   let _key = cacheKey fixModel fixCtx fixOpts    in testGroup         "shikumi-cache-postgres"@@ -81,5 +109,12 @@               runEff . runTime . runCachePostgres cache . runCountingLLM refB stubResponse . cachedLLM $                 complete fixModel fixCtx fixOpts             nB <- readIORef refB-            nB @?= 0+            nB @?= 0,+          testCase "a released connection degrades to MISS / no-op" $ do+            closed <- openCache+            closePostgresCache closed+            got <- runEff . runCachePostgres closed $ lookupCache (cacheKey fixModel fixCtx fixOpts)+            got @?= Nothing+            runEff . runCachePostgres closed $+              storeCache (cacheKey fixModel fixCtx fixOpts) entry         ]