keter-rate-limiting-plugin-0.2.0.0: Simple Keter rate limiting plugin.
Copyright(c) 2025 Oleksandr Zhabenko
LicenseMIT
Maintaineroleksandr.zhabenko@yahoo.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Data.TinyLRU

Description

This module provides a simple, thread-safe, and efficient Least Recently Used (LRU) cache. It is built using Software Transactional Memory (STM), making it suitable for concurrent applications.

The cache supports:

  • A fixed capacity, with automatic eviction of the least recently used item.
  • Time-based expiration (TTL) for each entry.
  • Generic key-value storage, with values being ToJSON/FromJSON serializable.
  • Atomic operations for safe concurrent access.

A typical use case involves creating a cache, and then using access or updateValue within an atomically block to interact with it.

Example Usage

import Control.Concurrent.STM
import Data.TinyLRU
import Data.Text (Text)
import System.Clock

main :: IO ()
main = do
  -- Initialize a cache with a capacity of 100 items.
  lru <- atomically $ initTinyLRU 100

  -- Add or retrieve a value.
  let key1 = "my-key" :: Text
  let value1 = "my-value" :: Text
  let ttlSeconds = 3600 -- 1 hour

  -- access is a get-or-insert operation.
  -- On first run, it inserts value1 and returns it.
  -- On subsequent runs, it returns the existing value.
  now <- getTime Monotonic
  retrievedValue <- atomically $ access now key1 value1 ttlSeconds lru
  print retrievedValue -- Should print: Just "my-value"

  -- Explicitly update a value.
  let newValue = "a-new-value" :: Text
  updatedValue <- atomically $ updateValue now key1 newValue ttlSeconds lru
  print updatedValue -- Should print: Just "a-new-value"

  -- Use the cache for rate limiting.
  let rateLimitKey = "user:123:login-attempts"
  -- Allow 5 requests per 60 seconds.
  isAllowed <- atomically $ allowRequestTinyLRU now lru rateLimitKey 5 60
  if isAllowed
    then putStrLn "Request allowed."
    else putStrLn "Rate limit exceeded."
Synopsis

Cache Type

data TinyLRUCache s Source #

The main data structure for the LRU cache. This is the handle you will use for all cache operations.

Constructors

TinyLRUCache 

Fields

Core API

initTinyLRU :: Int -> STM (TinyLRUCache s) Source #

Initializes a new TinyLRUCache with a specified capacity. This function must be run within an STM transaction.

lruCache <- atomically $ initTinyLRU 1000

The capacity must be greater than 0.

  • cap - The maximum number of items the cache can hold. Must be > 0.

Returns an STM action that yields a new, empty TinyLRUCache.

access :: (FromJSON a, ToJSON a) => TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a) Source #

Accesses a cache entry. This is the primary "get-or-insert" function.

The logic is as follows:

  1. It first cleans up any expired items in the cache.
  2. It looks for the key.
  3. If the key exists and is not expired, it moves the item to the front (as it's now the most recently used) and returns its value wrapped in Just.
  4. If the key does not exist, or if it exists but has expired, it inserts the provided new value. If the cache is full, it evicts the least recently used item before insertion. It then returns the new value wrapped in Just.
  5. If the key is invalid (empty or longer than 256 characters), it returns Nothing.
  • now - The current TimeSpec, for expiry checks.
  • key - The key to look up. Length must be between 1 and 256 characters.
  • val - The value to insert if the key is not found. It must have ToJSON and FromJSON instances.
  • ttl - The time-to-live in seconds for the new entry if it's inserted.
  • cache - The TinyLRUCache instance.

Returns an STM action that yields Just the value (either existing or newly inserted), or Nothing if the key is invalid.

updateValue :: (FromJSON a, ToJSON a) => TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a) Source #

Updates or inserts a cache entry. This is the primary "write" or "upsert" function.

The logic is as follows:

  1. It first cleans up any expired items in the cache.
  2. It looks for the key.
  3. If the key exists, it updates the value and expiry time, and moves it to the front.
  4. If the key does not exist, it inserts the new value. If the cache is full, it evicts the least recently used item first.
  5. If the key is invalid (empty or longer than 256 characters), it returns Nothing.

Unlike access, this function always writes the provided value.

  • now - The current TimeSpec, for expiry calculations.
  • key - The key to update or insert. Length must be between 1 and 256 characters.
  • val - The new value to write. It must have ToJSON and FromJSON instances.
  • ttl - The new time-to-live in seconds for the entry.
  • cache - The TinyLRUCache instance.

Returns an STM action that yields Just the value that was written, or Nothing if the key is invalid.

deleteKey :: Text -> TinyLRUCache s -> STM () Source #

Deletes an entry from the cache by its key. This removes the item from both the internal map and the linked list.

  • key - The key of the item to delete.
  • cache - The TinyLRUCache instance.

resetTinyLRU :: TinyLRUCache s -> STM () Source #

Resets the cache, removing all entries.

Rate Limiting

allowRequestTinyLRU :: TimeSpec -> TinyLRUCache s -> Text -> Int -> Int -> STM Bool Source #

A specialized function for rate limiting. It uses the cache to track the number of requests for a given key within a specific time period.

The logic is as follows:

  1. It looks for the key. The value associated with the key is treated as a counter (Int).
  2. If the entry for the key exists and is not expired: * If the counter is less than the limit, it increments the counter, refreshes the expiry time, and returns True (request allowed). * If the counter has reached the limit, it does nothing and returns False (request denied).
  3. If the entry does not exist or has expired, it creates a new entry with the counter set to 1 and returns True.
  • now - The current TimeSpec.
  • cache - The TinyLRUCache instance.
  • key - The key to identify the entity being rate-limited (e.g., a user ID or IP address).
  • limit - The maximum number of requests allowed.
  • period - The time period in seconds for the rate limit window.

Returns an STM action yielding True if the request is allowed, False otherwise.

Internals

These are lower-level components and functions. Most users will not need them directly.

data LRUList s Source #

Represents the doubly-linked list used to track the LRU order. It only stores pointers to the head (most recently used) and tail (least recently used) of the list.

Constructors

LRUList 

Fields

data LRUNode s Source #

Represents a single node in the LRU cache's doubly-linked list. Each node contains the key, value, expiry time, and pointers to the previous and next nodes.

Constructors

LRUNode 

Fields

isExpired :: TimeSpec -> LRUNode s -> Bool Source #

Checks if a cache node is expired relative to the current time.

Returns True if the node is expired, False otherwise.

addToFront :: TimeSpec -> Int -> TinyLRUCache s -> Text -> ByteString -> STM (TVar (LRUNode s)) Source #

Creates a new node and adds it to the front (most recently used position) of the cache's linked list.

  • now - The current TimeSpec, used for calculating expiry.
  • ttl - The time-to-live in seconds. A value <= 0 means it never expires.
  • cache - The TinyLRUCache instance.
  • key - The key for the new entry.
  • value - The ByteString value for the new entry.

Returns the TVar of the newly created LRUNode.

removeNode :: TVar (LRUList s) -> TVar (LRUNode s) -> STM () Source #

Atomically removes a node from the doubly-linked list. It correctly updates the nodePrev and nodeNext pointers of the neighboring nodes and the list's lruHead and lruTail pointers if necessary.

  • listTVar - The TVar of the LRUList from which to remove the node.
  • nodeTVar - The TVar of the LRUNode to remove.

moveToFront :: TVar (LRUList s) -> TVar (LRUNode s) -> STM () Source #

Moves an existing node to the front of the linked list, marking it as the most recently used. This is a core operation for the LRU logic.

evictLRU :: TinyLRUCache s -> STM () Source #

Evicts the least recently used item from the cache. This involves removing the tail of the linked list and deleting the corresponding entry from the hash map.

removeNodeFromCache :: TinyLRUCache s -> TVar (LRUNode s) -> STM () Source #

Low-level function to remove a node from the cache's list. Alias for removeNode. Most users should use deleteKey instead.

moveToFrontInCache :: TinyLRUCache s -> TVar (LRUNode s) -> STM () Source #

Low-level function to move a node to the front of the cache's list. Alias for moveToFront. Most users should use access or updateValue which call this internally.