{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Keter.RateLimiter.Types
Description : Core data types for rate limiting algorithms
Copyright   : (c) Oleksandr Zhabenko
License     : MIT
Maintainer  : oleksandr.zhabenko@yahoo.com
Stability   : experimental
Portability : POSIX

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}
@
-}
module Keter.RateLimiter.Types
  ( -- * Token Bucket Algorithm
    TokenBucketState(..)
    -- * Leaky Bucket Algorithm  
  , LeakyBucketState(..)
  ) where

import Data.Aeson (ToJSON, FromJSON(..), withObject, (.:))
import Control.Monad (when)
import GHC.Generics (Generic)

-- | 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 }
-- @
data TokenBucketState = TokenBucketState
  { TokenBucketState -> Int
tokens     :: Int  -- ^ Current number of available tokens in the bucket.
                       --   Must be non-negative. Represents the instantaneous
                       --   capacity available for processing requests.
  , TokenBucketState -> Int
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.
  } deriving (Int -> TokenBucketState -> ShowS
[TokenBucketState] -> ShowS
TokenBucketState -> String
(Int -> TokenBucketState -> ShowS)
-> (TokenBucketState -> String)
-> ([TokenBucketState] -> ShowS)
-> Show TokenBucketState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenBucketState -> ShowS
showsPrec :: Int -> TokenBucketState -> ShowS
$cshow :: TokenBucketState -> String
show :: TokenBucketState -> String
$cshowList :: [TokenBucketState] -> ShowS
showList :: [TokenBucketState] -> ShowS
Show, TokenBucketState -> TokenBucketState -> Bool
(TokenBucketState -> TokenBucketState -> Bool)
-> (TokenBucketState -> TokenBucketState -> Bool)
-> Eq TokenBucketState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenBucketState -> TokenBucketState -> Bool
== :: TokenBucketState -> TokenBucketState -> Bool
$c/= :: TokenBucketState -> TokenBucketState -> Bool
/= :: TokenBucketState -> TokenBucketState -> Bool
Eq, (forall x. TokenBucketState -> Rep TokenBucketState x)
-> (forall x. Rep TokenBucketState x -> TokenBucketState)
-> Generic TokenBucketState
forall x. Rep TokenBucketState x -> TokenBucketState
forall x. TokenBucketState -> Rep TokenBucketState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TokenBucketState -> Rep TokenBucketState x
from :: forall x. TokenBucketState -> Rep TokenBucketState x
$cto :: forall x. Rep TokenBucketState x -> TokenBucketState
to :: forall x. Rep TokenBucketState x -> TokenBucketState
Generic)

-- | 'ToJSON' instance for 'TokenBucketState'.
--
-- Serializes the token bucket state to JSON format for persistence or network transmission.
--
-- = JSON Format
--
-- @
-- {
--   "tokens": 42,
--   "lastUpdate": 1640995200
-- }
-- @
instance ToJSON TokenBucketState

-- | 'FromJSON' instance for 'TokenBucketState' with validation.
--
-- Deserializes JSON to 'TokenBucketState' with the following validation rules:
--
-- * 'tokens' field must be non-negative (>= 0)
-- * 'lastUpdate' field must be present and parseable as 'Int'
--
-- = 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 FromJSON TokenBucketState where
  parseJSON :: Value -> Parser TokenBucketState
parseJSON = String
-> (Object -> Parser TokenBucketState)
-> Value
-> Parser TokenBucketState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TokenBucketState" ((Object -> Parser TokenBucketState)
 -> Value -> Parser TokenBucketState)
-> (Object -> Parser TokenBucketState)
-> Value
-> Parser TokenBucketState
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
tokens <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tokens"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
tokens Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tokens must be non-negative"
    Int
lastUpdate <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastUpdate"
    TokenBucketState -> Parser TokenBucketState
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TokenBucketState { Int
tokens :: Int
tokens :: Int
tokens, Int
lastUpdate :: Int
lastUpdate :: Int
lastUpdate }

-- | 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 
--       }
-- @
data LeakyBucketState = LeakyBucketState
  { LeakyBucketState -> Double
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.
  , LeakyBucketState -> Double
lastTime   :: Double  -- ^ Timestamp of last bucket update as Unix time with
                          --   fractional seconds. Higher precision than 'TokenBucketState'
                          --   to support sub-second drain rate calculations.
  } deriving (Int -> LeakyBucketState -> ShowS
[LeakyBucketState] -> ShowS
LeakyBucketState -> String
(Int -> LeakyBucketState -> ShowS)
-> (LeakyBucketState -> String)
-> ([LeakyBucketState] -> ShowS)
-> Show LeakyBucketState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeakyBucketState -> ShowS
showsPrec :: Int -> LeakyBucketState -> ShowS
$cshow :: LeakyBucketState -> String
show :: LeakyBucketState -> String
$cshowList :: [LeakyBucketState] -> ShowS
showList :: [LeakyBucketState] -> ShowS
Show, LeakyBucketState -> LeakyBucketState -> Bool
(LeakyBucketState -> LeakyBucketState -> Bool)
-> (LeakyBucketState -> LeakyBucketState -> Bool)
-> Eq LeakyBucketState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeakyBucketState -> LeakyBucketState -> Bool
== :: LeakyBucketState -> LeakyBucketState -> Bool
$c/= :: LeakyBucketState -> LeakyBucketState -> Bool
/= :: LeakyBucketState -> LeakyBucketState -> Bool
Eq, (forall x. LeakyBucketState -> Rep LeakyBucketState x)
-> (forall x. Rep LeakyBucketState x -> LeakyBucketState)
-> Generic LeakyBucketState
forall x. Rep LeakyBucketState x -> LeakyBucketState
forall x. LeakyBucketState -> Rep LeakyBucketState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeakyBucketState -> Rep LeakyBucketState x
from :: forall x. LeakyBucketState -> Rep LeakyBucketState x
$cto :: forall x. Rep LeakyBucketState x -> LeakyBucketState
to :: forall x. Rep LeakyBucketState x -> LeakyBucketState
Generic)

-- | '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 ToJSON LeakyBucketState

-- | '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 FromJSON LeakyBucketState where
  parseJSON :: Value -> Parser LeakyBucketState
parseJSON = String
-> (Object -> Parser LeakyBucketState)
-> Value
-> Parser LeakyBucketState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LeakyBucketState" ((Object -> Parser LeakyBucketState)
 -> Value -> Parser LeakyBucketState)
-> (Object -> Parser LeakyBucketState)
-> Value
-> Parser LeakyBucketState
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Double
level <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
level Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"level must be non-negative"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
level Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1000000) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"level must not exceed 1000000"
    Double
lastTime <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastTime"
    LeakyBucketState -> Parser LeakyBucketState
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return LeakyBucketState { Double
level :: Double
level :: Double
level, Double
lastTime :: Double
lastTime :: Double
lastTime }