{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Keter.RateLimiter.SlidingWindow
-- Description : Sliding window rate limiting algorithm implementation
-- Copyright   : (c) 2025 Oleksandr Zhabenko
-- License     : MIT
-- Maintainer  : oleksandr.zhabenko@yahoo.com
-- Stability   : stable
-- Portability : portable
--
-- This module provides an implementation of the /Sliding Window Counter/
-- algorithm for rate limiting. It is implemented using STM primitives and
-- integrates with the "Keter.RateLimiter.Cache" key structure.
--
-- A sliding window allows a fixed number of requests within a moving time
-- interval (window). It tracks individual request timestamps and filters them
-- to only keep those within the defined time window. This allows for
-- fine-grained request control and smooth rate-limiting behavior.
--
-- == Example usage
--
-- @
-- let getTimeNow = realToFrac \<$\> getPOSIXTime
-- result <- allowRequest getTimeNow myMap \"zone1\" \"user42\" 60 100
-- when result (putStrLn \"Request allowed\")
-- @
--
-- This example checks whether @\"user42\"@ from @\"zone1\"@ can make a request,
-- allowing up to 100 requests in a 60-second window.

module Keter.RateLimiter.SlidingWindow
  ( -- * Sliding Window Rate Limiting
    allowRequest
  ) where

import Keter.RateLimiter.Cache (makeCacheKey, Algorithm(SlidingWindow))
import Data.Text (Text)
import Control.Concurrent.STM
import qualified StmContainers.Map as StmMap
import qualified Focus

--------------------------------------------------------------------------------

-- | Check whether a request is allowed under the sliding window policy.
--
-- This function implements a time-based sliding window algorithm. Each client
-- is associated with a list of timestamps representing past allowed requests.
-- If the number of timestamps in the current time window exceeds the limit,
-- the request is denied.
--
-- This version is /thread-safe/ and uses STM to avoid race conditions under
-- concurrency. The timestamp list is updated atomically using 'StmMap.focus'.
--
-- === Algorithm Steps
--
-- 1. __Time Acquisition__: Get current timestamp using provided time function
-- 2. __Key Construction__: Build composite cache key from throttle name, IP zone, and user key
-- 3. __Atomic Update__: Use STM Focus to atomically read, filter, and update timestamp list
-- 4. __Window Filtering__: Remove timestamps older than the sliding window
-- 5. __Limit Check__: Allow request if filtered list length is below limit
-- 6. __State Update__: Add current timestamp to list if request is allowed
--
-- === Memory Management
--
-- The algorithm automatically cleans up old timestamps and removes empty entries
-- from the map, ensuring efficient memory usage for long-running applications.
--
-- ==== __Examples__
--
-- @
-- -- Basic API rate limiting: 100 requests per minute
-- getTime <- realToFrac \<$\> getPOSIXTime
-- allowed <- allowRequest (pure getTime) stmMapTVar \"api\" \"zone1\" \"user123\" 60 100
-- if allowed 
--   then processApiRequest
--   else sendRateLimitError
-- @
--
-- @
-- -- High-frequency trading API: 1000 requests per second
-- let getTimeIO = realToFrac \<$\> getPOSIXTime
-- result <- allowRequest getTimeIO storage \"hft\" \"premium\" \"trader456\" 1 1000
-- when result $ executeTrade
-- @
--
-- @
-- -- Multi-tier rate limiting with different windows
-- let (windowSecs, maxReqs) = case userTier of
--       Premium  -> (60, 1000)    -- 1000 requests per minute
--       Standard -> (60, 100)     -- 100 requests per minute  
--       Free     -> (3600, 50)    -- 50 requests per hour
--
-- allowed <- allowRequest getTime storage \"tiered\" zone userId windowSecs maxReqs
-- @
--
-- /Thread Safety:/ All operations are atomic via STM. Multiple threads can
-- safely call this function concurrently for the same or different keys.
--
-- /Performance:/ Time complexity is O(n) where n is the number of timestamps
-- within the sliding window. Space complexity is O(k*n) where k is the number
-- of active clients.
allowRequest
  :: IO Double
  -- ^ Action to get current time as fractional seconds since epoch
  -> TVar (StmMap.Map Text [Double])
  -- ^ STM map storing per-client timestamp lists
  -> Text
  -- ^ Throttle name (logical grouping identifier)
  -> Text
  -- ^ IP zone identifier for multi-tenant isolation
  -> Text
  -- ^ User key (unique client identifier)
  -> Int
  -- ^ Sliding window size in seconds (must be positive)
  -> Int
  -- ^ Maximum allowed requests within the time window (must be positive)
  -> IO Bool
  -- ^ 'True' if request is allowed, 'False' if rate-limited
allowRequest :: IO Double
-> TVar (Map Text [Double])
-> Text
-> Text
-> Text
-> Int
-> Int
-> IO Bool
allowRequest IO Double
getTimeNow TVar (Map Text [Double])
stmMapTVar Text
throttleName Text
ipZone Text
userKey Int
windowSize Int
limit = do
  Double
now <- IO Double
getTimeNow
  let key :: Text
key = Text -> Algorithm -> Text -> Text -> Text
makeCacheKey Text
throttleName Algorithm
SlidingWindow Text
ipZone Text
userKey
      windowSizeD :: Double
windowSizeD = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
windowSize

  STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    Map Text [Double]
stmMap <- TVar (Map Text [Double]) -> STM (Map Text [Double])
forall a. TVar a -> STM a
readTVar TVar (Map Text [Double])
stmMapTVar
    Focus [Double] STM Bool -> Text -> Map Text [Double] -> STM Bool
forall key value result.
Hashable key =>
Focus value STM result -> key -> Map key value -> STM result
StmMap.focus (Double -> Double -> Int -> Focus [Double] STM Bool
updateTimestamps Double
now Double
windowSizeD Int
limit) Text
key Map Text [Double]
stmMap

--------------------------------------------------------------------------------

-- | Internal helper that atomically updates the timestamp list using STM Focus.
--
-- This function removes timestamps that are older than the current window,
-- and determines if the current request is allowed. If so, the current time
-- is appended to the list. If the list becomes empty, the entry is removed
-- from the map.
--
-- This ensures memory-efficient cleanup of old clients and automatic garbage
-- collection of inactive entries.
--
-- === Behavior Details
--
-- * If the client has no prior entries, the request is allowed and a new list is created.
-- * If the client exists, the list is trimmed to remove stale timestamps.
-- * The request is allowed only if the filtered list has fewer than the specified limit.
-- * Empty timestamp lists are automatically removed from the map.
--
-- === Algorithm Complexity
--
-- * /Time/: O(n) where n is the number of timestamps in the current window
-- * /Space/: O(1) additional space per operation (filtering is done in-place conceptually)
updateTimestamps
  :: Double
  -- ^ Current time in fractional seconds
  -> Double  
  -- ^ Sliding window duration in seconds
  -> Int
  -- ^ Request limit within the window
  -> Focus.Focus [Double] STM Bool
  -- ^ STM Focus that returns whether the request is allowed
updateTimestamps :: Double -> Double -> Int -> Focus [Double] STM Bool
updateTimestamps Double
now Double
windowSize Int
limit = STM (Bool, Change [Double])
-> ([Double] -> STM (Bool, Change [Double]))
-> Focus [Double] STM Bool
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus.Focus
  (do
    -- New client: allow first request and create timestamp list
    let newList :: [Double]
newList = [Double
now]
    (Bool, Change [Double]) -> STM (Bool, Change [Double])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, [Double] -> Change [Double]
forall a. a -> Change a
Focus.Set [Double]
newList)
  )
  (\[Double]
currentTimestamps -> do
    -- Existing client: filter old timestamps and check limit
    let freshTimestamps :: [Double]
freshTimestamps = (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Double
t -> Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
windowSize) [Double]
currentTimestamps
    let allowed :: Bool
allowed = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
freshTimestamps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit
    let updatedTimestamps :: [Double]
updatedTimestamps = if Bool
allowed then Double
now Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
freshTimestamps else [Double]
freshTimestamps
    
    -- Clean up empty entries to prevent memory leaks
    if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
updatedTimestamps
      then (Bool, Change [Double]) -> STM (Bool, Change [Double])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
allowed, Change [Double]
forall a. Change a
Focus.Remove)
      else (Bool, Change [Double]) -> STM (Bool, Change [Double])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
allowed, [Double] -> Change [Double]
forall a. a -> Change a
Focus.Set [Double]
updatedTimestamps)
  )