shared-resource-cache 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+33/−12 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +10/−0
- shared-resource-cache.cabal +1/−1
- src/Data/SharedResourceCache/Internal/ExpiringSharedResourceCache.hs +22/−11
CHANGELOG.md view
@@ -8,6 +8,16 @@ ## Unreleased +## 0.1.0.1 - 2026-03-22++### Fixed++- Fixed a resource leak where an async exception delivered to the loading thread+ after a successful `putIntoCache` STM commit could leave a cache entry with its+ sharer count permanently stuck at 1, preventing eviction. The entry is now+ correctly decremented (and scheduled for eviction if no other sharers remain)+ via `adjustCacheEntryOnLoadError`.+ ## 0.1.0.0 - 2026-03-22 ### Added
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: shared-resource-cache-version: 0.1.0.0+version: 0.1.0.1 synopsis: A thread-safe cache for sharing resources across threads with automatic expiry description: A cache designed for guaranteeing that different threads can share the same reference to a resource. For example, it allows threads to communicate via a shared <<https://hackage.haskell.org/package/stm-2.5.3.1/docs/Control-Concurrent-STM-TChan.html TChan broadcast channel>>.
@@ -7,7 +7,7 @@ import Data.Time (UTCTime) import Control.Concurrent.STM (STM) import Control.Exception ( mask,- uninterruptibleMask_, finally )+ uninterruptibleMask_, onException ) import Control.Monad.STM (atomically) import Control.Monad (void, when)@@ -16,7 +16,8 @@ import Data.Time.Clock (getCurrentTime) import Control.Concurrent.MVar (newEmptyMVar) import Control.Concurrent.STM.TVar (newTVar)-+ import Data.Either (isLeft)+ -- | A cache of resources that can be shared between multiple threads (such as a TChan broadcast channel.) -- data SharedResourceCache err a = SharedResourceCache {@@ -74,9 +75,13 @@ Nothing -> restore $ loadCacheableResource resourceCache resourceId -- We've claimed ownership of loading the item into the cache- Just semaphore ->- restore (loadIntoCache resourceCache resourceId semaphore)- `finally` uninterruptibleMask_ (removeLoadingClaim resourceCache resourceId >> signalCacheLoaded semaphore)+ Just semaphore -> do+ result <- restore (loadIntoCache resourceCache resourceId semaphore)+ `onException` uninterruptibleMask_ (adjustCacheEntryOnLoadError resourceCache resourceId >> signalCacheLoaded semaphore)++ when (isLeft result) (uninterruptibleMask_ (adjustCacheEntryOnLoadError resourceCache resourceId))+ signalCacheLoaded semaphore+ pure result ) where@@ -111,10 +116,16 @@ M.insert (LoadedEntry entry) resourceId cache pure (Right entry) - removeLoadingClaim :: SharedResourceCache err a -> Text -> IO ()- removeLoadingClaim resourceCache@(SharedResourceCache cache _ _ _ _ _) resourceId = atomically $ do- result <- M.lookup resourceId cache+ adjustCacheEntryOnLoadError :: SharedResourceCache err a -> Text -> IO ()+ adjustCacheEntryOnLoadError resourceCache@(SharedResourceCache cache _ _ _ _ _) resourceId = do + now <- getCurrentTime - case result of- Just (LoadingEntry _) -> void (M.delete resourceId cache)- _ -> pure ()+ atomically $ do+ result <- M.lookup resourceId cache+ case result of+ -- Error occurred before we were able to load the cache entry - delete it+ Just (LoadingEntry _) -> M.delete resourceId cache+ -- Error occurred after we loaded the cache entry meaning although we won't subscribe other threads may+ -- until the entry is expired+ Just (LoadedEntry item) -> handleSharerLeaveSTM resourceCache item resourceId now+ _ -> pure ()