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

Keter.RateLimiter.RequestUtils

Description

Utility helpers for extracting stable textual keys from a WAI Request. They are primarily intended for use with rate-limiting middleware (see the keter-rate-limiting-plugin package) but are fully generic and can be employed anywhere you need a deterministic identifier that ties a request to its origin (IP address, path, user-agent, …).

The helpers follow these rules:

  1. Zero allocation whenever the value is already available in the request record (e.g. rawPathInfo or requestMethod are reused verbatim).
  2. No reverse DNS or other network round-trips -- the functions are pure and fast.
  3. Header names are handled case-insensitively via the CI type.

Quick example

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad.IO.Class (liftIO)
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200)
import Keter.RateLimiter.RequestUtils (byIPAndPath)
import Data.Text.IO as TIO

logKey :: Request -> IO ()
logKey req = do
  mk <- byIPAndPath req
  case mk of
    Nothing  -> TIO.putStrLn "cannot build key"
    Just key -> TIO.putStrLn ("request key = " <> key)

app :: Application
app req respond = liftIO (logKey req) >> respond (responseLBS status200 [] OK)

main :: IO ()
main = run 8080 app

Converting sockets to text

Functions ipv4ToString and ipv6ToString perform a lossless conversion of binary socket addresses to their canonical textual representations. The implementation is intentionally simple and does not attempt to compress IPv6 zeros (you get four-hextet groups padded to 4 digits).

Synopsis

Low-level helpers

ipv4ToString :: HostAddress -> Text Source #

Convert an IPv4 HostAddress to dotted-decimal Text.

Example

Expand
>>> ipv4ToString 0x7f000001     -- 127.0.0.1
"127.0.0.1"

ipv6ToString :: HostAddress6 -> Text Source #

Render an IPv6 HostAddress6 as eight 16-bit hex blocks separated by :. Each block is zero-padded to four characters. This rendering is canonical but not compressed (e.g., it does not use ::).

The function is micro-optimised to avoid lists and string formatting functions.

Example

Expand
>>> ipv6ToString (0,0,0,1)
"0000:0000:0000:0000:0000:0000:0000:0001"

Basic request information

getClientIP :: Request -> IO Text Source #

Best-effort client IP address detection.

This function attempts to find the most accurate client IP address by checking common proxy headers first, falling back to the direct socket address if they are not present.

The priority order for detection is:

  1. X-Forwarded-For (takes the first IP in the comma-separated list).
  2. X-Real-Ip.
  3. The remoteHost from the WAI Request object.

Header names are matched case-insensitively. IPv4 and IPv6 addresses are converted to text using ipv4ToString and ipv6ToString respectively. Unix sockets are represented by their file path.

getRequestPath :: Request -> Text Source #

Extracts the raw path info from the request and decodes it using lenient UTF-8 Text. This is equivalent to decodeUtf8With lenientDecode . rawPathInfo.

getRequestMethod :: Request -> Text Source #

Extracts the HTTP request method (e.g., GET, POST) and returns it as a Text value. This is equivalent to decodeUtf8 . requestMethod (methods are ASCII).

getRequestHost :: Request -> Maybe Text Source #

Extracts the value of the Host header, if present, using lenient UTF-8 decoding.

getRequestUserAgent :: Request -> Maybe Text Source #

Extracts the value of the User-Agent header, if present, using lenient UTF-8 decoding.

Composite key builders

byIP :: Request -> IO (Maybe Text) Source #

Creates a request key based solely on the client's IP address.

This function always succeeds and returns a Just value, as every WAI request has an associated socket address (IPv4, IPv6, or Unix socket).

Example

Expand
byIP req ⇨ pure (Just "127.0.0.1")

byIPAndPath :: Request -> IO (Maybe Text) Source #

Creates a composite key by combining the client IP and the request path, separated by a colon.

This is useful for rate-limiting access to specific endpoints rather than penalizing a client for all of its requests. This function always succeeds since both IP and path are always available.

Example

Expand
-- For a request to /api/v1/users from 192.168.1.10
byIPAndPath req ⇨ pure (Just "192.168.1.10:/api/v1/users")

byIPAndUserAgent :: Request -> IO (Maybe Text) Source #

Creates a composite key by combining the client IP and the User-Agent header, separated by a colon.

Returns Nothing if the User-Agent header is not present in the request.

Example

Expand
-- For a request from Googlebot at 8.8.8.8
byIPAndUserAgent req ⇨ pure (Just "8.8.8.8:Mozilla/5.0 (compatible; Googlebot/2.1)")

byHeaderAndIP :: HeaderName -> Request -> IO (Maybe Text) Source #

Builds a key from an arbitrary header and the client IP, joined by a colon.

Header lookup is case-insensitive. Returns Nothing if the specified header is absent from the request.

Example

Expand

This can be used to rate-limit based on an API key plus the user's IP.

-- Given a request with header "X-Api-Key: mysecret" from 1.2.3.4
byHeaderAndIP "x-api-key" req ⇨ pure (Just "1.2.3.4:mysecret")