shikumi-cache-postgres (empty) → 0.1.0.0

raw patch · 4 files changed

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

Dependencies added: aeson, baikai, base, effectful, ephemeral-pg, generic-lens, hasql, lens, shikumi, shikumi-cache, shikumi-cache-postgres, tasty, tasty-hunit, text, vector

Files

• CHANGELOG.md +10/−0
• shikumi-cache-postgres.cabal +67/−0
• src/Shikumi/Cache/Backend/Postgres.hs +108/−0
• test/Main.hs +85/−0

@@ -0,0 +1,10 @@+# Changelog++## Unreleased++## 0.1.0.0 - 2026-06-13++### Added++- Initial Hackage release of the PostgreSQL backend for shikumi-cache.+- Postgres connection lifecycle helpers, table initialization, lookup, store, and cache interpreter support.

@@ -0,0 +1,67 @@+cabal-version:   3.4+name:            shikumi-cache-postgres+version:         0.1.0.0+synopsis:        Postgres-backed shikumi cache (EP-6)+category:        AI+description:+  A PostgreSQL backend for shikumi's @Cache@ effect (EP-6), in a separate+  package so the @hasql@ client (and libpq) is only pulled in when used. Entries+  live in a @shikumi_cache(key text primary key, value jsonb, stored_at+  timestamptz)@ table, upserted on conflict; the value is the JSON of a+  @CachedResponse@ (the @Response@ round-trip comes from @shikumi-cache@'s+  @Shikumi.Cache.ResponseJSON@). The test uses @ephemeral-pg@ to spin up a+  throwaway server, so it needs no external database.++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+    MultilineStrings+    OverloadedLabels+    OverloadedStrings++library+  import:          common-options+  hs-source-dirs:  src+  exposed-modules: Shikumi.Cache.Backend.Postgres+  build-depends:+    , aeson+    , base           >=4.20     && <5+    , effectful+    , hasql+    , shikumi-cache  ^>=0.1.0.0+    , text           ^>=2.1++test-suite shikumi-cache-postgres-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+    , effectful+    , ephemeral-pg+    , generic-lens+    , lens+    , shikumi                 ^>=0.1.0.0+    , shikumi-cache           ^>=0.1.0.0+    , shikumi-cache-postgres  ^>=0.1.0.0+    , tasty+    , tasty-hunit+    , text+    , vector

@@ -0,0 +1,108 @@+-- | The Postgres cache backend (EP-6) — a server-backed, cross-machine store+-- with a durable SQL table.+--+-- 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'+-- 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.+module Shikumi.Cache.Backend.Postgres+  ( PostgresCache,+    openPostgresCache,+    closePostgresCache,+    runCachePostgres,+  )+where++import Control.Concurrent.MVar (MVar, newMVar, withMVar)+import Control.Exception (throwIO)+import Data.Aeson (Result (Error, Success), Value, fromJSON, toJSON)+import Data.Functor.Contravariant ((>$<))+import Data.Text (Text)+import Effectful (Eff, IOE, liftIO, (:>))+import Effectful.Dispatch.Dynamic (interpret)+import Hasql.Connection (Connection)+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings (Settings)+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Session (statement)+import Hasql.Statement (Statement, preparable, unpreparable)+import Shikumi.Cache (Cache (..), CacheKey (unCacheKey), CachedResponse)++-- | 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 {pgConn :: MVar Connection}++-- | Connect using the given hasql settings (e.g. @EphemeralPg.connectionSettings@+-- for tests, or @Hasql.Connection.Settings@ builders in production), ensuring the+-- @shikumi_cache@ table exists. Throws on a connection or schema-creation error.+openPostgresCache :: Settings -> IO PostgresCache+openPostgresCache settings = do+  res <- Connection.acquire settings+  case res of+    Left err -> throwIO (userError ("shikumi-cache-postgres: connection failed: " <> show err))+    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++-- | Release the connection.+closePostgresCache :: PostgresCache -> IO ()+closePostgresCache (PostgresCache mv) = withMVar mv Connection.release++-- | 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 ()++-- | @CREATE TABLE IF NOT EXISTS@ (unpreparable — it is a utility statement).+createTableStmt :: Statement () ()+createTableStmt =+  unpreparable+    """+    CREATE TABLE IF NOT EXISTS shikumi_cache+      ( key       text PRIMARY KEY+      , value     jsonb NOT NULL+      , stored_at timestamptz NOT NULL DEFAULT now()+      )+    """+    mempty+    D.noResult++-- | SELECT the jsonb value for a key (NULL row → 'Nothing').+lookupStmt :: Statement Text (Maybe Value)+lookupStmt =+  preparable+    """+    SELECT value FROM shikumi_cache WHERE key = $1+    """+    (E.param (E.nonNullable E.text))+    (D.rowMaybe (D.column (D.nonNullable D.jsonb)))++-- | Upsert the jsonb value for a key (idempotent).+storeStmt :: Statement (Text, Value) ()+storeStmt =+  preparable+    """+    INSERT INTO shikumi_cache (key, value) VALUES ($1, $2)+    ON CONFLICT (key) DO UPDATE SET value = excluded.value, stored_at = now()+    """+    ( (fst >$< E.param (E.nonNullable E.text))+        <> (snd >$< E.param (E.nonNullable E.jsonb))+    )+    D.noResult

@@ -0,0 +1,85 @@+-- | EP-6 Postgres backend acceptance. Round-trips a @CachedResponse@ through a+-- real PostgreSQL via the @cachedLLM@ memoizer + a counting stub provider: the+-- first request is a MISS (provider called once, row upserted), a subsequent+-- request is a HIT served from Postgres (no further provider call).+--+-- 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).+module Main (main) where++import Baikai (Context, Model, Options, Response, user, _Context, _Model, _Options, _Response)+import Control.Exception (finally)+import Control.Lens ((&), (.~))+import Data.Generics.Labels ()+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.Text qualified as T+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.Backend.Postgres (PostgresCache, closePostgresCache, openPostgresCache, runCachePostgres)+import Shikumi.Effect.Time (runTime)+import Shikumi.LLM (LLM (..), complete)+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+  started <- Pg.start Pg.defaultConfig+  case started of+    Left err -> do+      putStrLn ("[SKIP] shikumi-cache-postgres: " <> T.unpack (Pg.renderStartError err))+      exitSuccess+    Right db -> do+      cache <- openPostgresCache (Pg.connectionSettings db)+      defaultMain (tests cache)+        `finally` (closePostgresCache cache >> Pg.stop db)++-- 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 =+  let _key = cacheKey fixModel fixCtx fixOpts+   in testGroup+        "shikumi-cache-postgres"+        [ testCase "memoize: first request MISS (provider once), repeat is a Postgres HIT" $ do+            refA <- newIORef 0+            (r1, r2) <-+              runEff . runTime . runCachePostgres 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 row already in Postgres → HIT.+            refB <- newIORef 0+            _ <-+              runEff . runTime . runCachePostgres cache . runCountingLLM refB stubResponse . cachedLLM $+                complete fixModel fixCtx fixOpts+            nB <- readIORef refB+            nB @?= 0+        ]