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

Keter.RateLimiter.Types

Description

This module provides the fundamental data types used in Keter's rate limiting system. It defines state representations for two common rate limiting algorithms:

  • Token Bucket: A rate limiting algorithm that maintains a bucket of tokens, where each request consumes a token. Tokens are replenished at a fixed rate.
  • Leaky Bucket: A rate limiting algorithm that models a bucket with a hole, where requests fill the bucket and it drains at a constant rate.

Both types support JSON serialization for persistence and configuration purposes, with validation to ensure state consistency.

Example Usage

-- Token bucket example
let tokenState = TokenBucketState { tokens = 100, lastUpdate = 1640995200 }
print tokenState  -- TokenBucketState {tokens = 100, lastUpdate = 1640995200}

-- Leaky bucket example  
let leakyState = LeakyBucketState { level = 0.5, lastTime = 1640995200.123 }
print leakyState  -- LeakyBucketState {level = 0.5, lastTime = 1640995200.123}
Synopsis

Token Bucket Algorithm

data TokenBucketState Source #

State representation for the Token Bucket rate limiting algorithm.

The token bucket algorithm maintains a bucket that holds tokens up to a maximum capacity. Each incoming request consumes one or more tokens from the bucket. Tokens are replenished at a fixed rate. If insufficient tokens are available, the request is either delayed or rejected.

Token Bucket Properties

  • Bursty Traffic: Allows bursts of traffic up to the bucket capacity
  • Rate Control: Long-term average rate is controlled by token replenishment rate
  • Memory Efficient: Only requires tracking token count and last update time

Use Cases

  • API rate limiting with burst allowance
  • Network traffic shaping
  • Resource allocation with temporary overages

Example

-- Initial state with 50 tokens, last updated at Unix timestamp 1640995200
let initialState = TokenBucketState 
      { tokens = 50
      , lastUpdate = 1640995200 
      }

-- After consuming 10 tokens
let afterConsumption = initialState { tokens = 40 }

Constructors

TokenBucketState 

Fields

  • tokens :: Int

    Current number of available tokens in the bucket. Must be non-negative. Represents the instantaneous capacity available for processing requests.

  • lastUpdate :: Int

    Unix timestamp (seconds since epoch) of the last bucket state update. Used to calculate how many tokens should be replenished based on elapsed time.

Instances

Instances details
FromJSON TokenBucketState Source #

FromJSON instance for TokenBucketState with validation.

Deserializes JSON to TokenBucketState with the following validation rules:

Validation Examples

-- Valid JSON
decode "{"tokens": 10, "lastUpdate": 1640995200}" :: Maybe TokenBucketState
-- Just (TokenBucketState {tokens = 10, lastUpdate = 1640995200})

-- Invalid JSON (negative tokens)
decode "{"tokens": -5, "lastUpdate": 1640995200}" :: Maybe TokenBucketState  
-- Nothing

Throws a parse error if tokens is negative or required fields are missing.

Instance details

Defined in Keter.RateLimiter.Types

ToJSON TokenBucketState Source #

ToJSON instance for TokenBucketState.

Serializes the token bucket state to JSON format for persistence or network transmission.

JSON Format

{
  "tokens": 42,
  "lastUpdate": 1640995200
}
Instance details

Defined in Keter.RateLimiter.Types

Generic TokenBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

Associated Types

type Rep TokenBucketState 
Instance details

Defined in Keter.RateLimiter.Types

type Rep TokenBucketState = D1 ('MetaData "TokenBucketState" "Keter.RateLimiter.Types" "keter-rate-limiting-plugin-0.2.0.0-H4WU5a5Xu20FyQxdNRgnJy" 'False) (C1 ('MetaCons "TokenBucketState" 'PrefixI 'True) (S1 ('MetaSel ('Just "tokens") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "lastUpdate") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))
Show TokenBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

Eq TokenBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

CacheStore (InMemoryStore 'TokenBucket) TokenBucketState IO Source #

CacheStore instance for TokenBucket algorithm.

Provides access to token bucket state while maintaining the worker thread infrastructure. Read operations return current bucket state, write operations update state and manage worker lifecycle.

Instance details

Defined in Keter.RateLimiter.Cache

type Rep TokenBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

type Rep TokenBucketState = D1 ('MetaData "TokenBucketState" "Keter.RateLimiter.Types" "keter-rate-limiting-plugin-0.2.0.0-H4WU5a5Xu20FyQxdNRgnJy" 'False) (C1 ('MetaCons "TokenBucketState" 'PrefixI 'True) (S1 ('MetaSel ('Just "tokens") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "lastUpdate") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

Leaky Bucket Algorithm

data LeakyBucketState Source #

State representation for the Leaky Bucket rate limiting algorithm.

The leaky bucket algorithm models a bucket with a hole in the bottom that drains at a constant rate. Incoming requests add water to the bucket, and if the bucket overflows, requests are rejected. This provides smooth rate limiting without bursts.

Leaky Bucket Properties

  • Smooth Rate: Enforces a consistent output rate regardless of input bursts
  • No Bursts: Unlike token bucket, doesn't allow temporary rate exceedance
  • Queue Modeling: Can model request queuing with bucket level representing queue depth

Use Cases

  • Smooth traffic shaping for network connections
  • Audio/video streaming rate control
  • Database connection throttling
  • Prevention of thundering herd problems

Mathematical Model

The bucket level changes according to:

newLevel = max(0, oldLevel + requestSize - drainRate * timeDelta)

Where:

  • requestSize is the size of the incoming request
  • drainRate is the constant drain rate (requests per second)
  • timeDelta is the elapsed time since last update

Example

-- Initial state: half-full bucket at timestamp 1640995200.5
let initialState = LeakyBucketState 
      { level = 0.5
      , lastTime = 1640995200.5 
      }

-- After 1 second with drain rate 0.1/sec and no new requests
let afterDrain = initialState 
      { level = 0.4  -- 0.5 - 0.1*1.0
      , lastTime = 1640995201.5 
      }

Constructors

LeakyBucketState 

Fields

  • level :: Double

    Current fill level of the bucket (0.0 to capacity). Represents the amount of "water" (pending requests) currently in the bucket. Higher values indicate more backpressure or pending work.

  • lastTime :: Double

    Timestamp of last bucket update as Unix time with fractional seconds. Higher precision than TokenBucketState to support sub-second drain rate calculations.

Instances

Instances details
FromJSON LeakyBucketState Source #

FromJSON instance for LeakyBucketState with validation.

Deserializes JSON to LeakyBucketState with the following validation rules:

  • level must be non-negative (>= 0.0)
  • level must not exceed 1,000,000 (practical upper bound)
  • lastTime must be present and parseable as Double

The upper bound on level prevents potential overflow issues and ensures reasonable memory usage for bucket state tracking.

Validation Examples

-- Valid JSON
decode "{"level": 42.5, "lastTime": 1640995200.123}" :: Maybe LeakyBucketState
-- Just (LeakyBucketState {level = 42.5, lastTime = 1640995200.123})

-- Invalid JSON (negative level)
decode "{"level": -1.0, "lastTime": 1640995200.0}" :: Maybe LeakyBucketState
-- Nothing

-- Invalid JSON (level too high) 
decode "{"level": 2000000.0, "lastTime": 1640995200.0}" :: Maybe LeakyBucketState
-- Nothing

Throws a parse error if level is negative, exceeds 1,000,000, or required fields are missing.

Instance details

Defined in Keter.RateLimiter.Types

ToJSON LeakyBucketState Source #

ToJSON instance for LeakyBucketState.

Serializes the leaky bucket state to JSON format with full double precision.

JSON Format

{
  "level": 123.456,
  "lastTime": 1640995200.789
}
Instance details

Defined in Keter.RateLimiter.Types

Generic LeakyBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

Associated Types

type Rep LeakyBucketState 
Instance details

Defined in Keter.RateLimiter.Types

type Rep LeakyBucketState = D1 ('MetaData "LeakyBucketState" "Keter.RateLimiter.Types" "keter-rate-limiting-plugin-0.2.0.0-H4WU5a5Xu20FyQxdNRgnJy" 'False) (C1 ('MetaCons "LeakyBucketState" 'PrefixI 'True) (S1 ('MetaSel ('Just "level") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "lastTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))
Show LeakyBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

Eq LeakyBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

CacheStore (InMemoryStore 'LeakyBucket) LeakyBucketState IO Source #

CacheStore instance for LeakyBucket algorithm.

Similar to TokenBucket but for continuous drain semantics. Manages leaky bucket state and worker thread lifecycle.

Instance details

Defined in Keter.RateLimiter.Cache

type Rep LeakyBucketState Source # 
Instance details

Defined in Keter.RateLimiter.Types

type Rep LeakyBucketState = D1 ('MetaData "LeakyBucketState" "Keter.RateLimiter.Types" "keter-rate-limiting-plugin-0.2.0.0-H4WU5a5Xu20FyQxdNRgnJy" 'False) (C1 ('MetaCons "LeakyBucketState" 'PrefixI 'True) (S1 ('MetaSel ('Just "level") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "lastTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))