Wai

This module defines a generic web application interface. It is a common protocol between web servers and web applications. The overriding design principles here are performance and generality. To address performance, this library uses a streaming interface for request and response bodies, paired with bytestring's Builder type. The advantages of a streaming API over lazy IO have been debated elsewhere and so will not be addressed here. However, helper functions like responseLBS allow you to continue using lazy IO if you so desire. Generality is achieved by removing many variables commonly found in similar projects that are not universal to all servers. The goal is that the Request object contains only data which is meaningful in all circumstances. Please remember when using this package that, while your application may compile without a hitch against many different servers, there are other considerations to be taken when moving to a new backend. For example, if you transfer from a CGI application to a FastCGI one, you might suddenly find you have a memory leak. Conversely, a FastCGI application would be well served to preload all templates from disk when first starting; this would kill the performance of a CGI application. This package purposely provides very little functionality. You can find various middlewares, backends and utilities on Hackage. Some of the most commonly used include:

• warp http://hackage.haskell.org/package/warp
• wai-extra http://hackage.haskell.org/package/wai-extra

Have a look at the README for an example of how to use this library.

Test a Application Example usage:

exampleApplication :: Wai.Application
exampleApplication req sendResp = do
lb <- strictRequestBody req
sendResp $ responseLBS HTTP.ok200 (requestHeaders req) lb

spec :: Spec
spec =
waiClientSpec exampleApplication $
describe "get" $
it "can GET the root and get a 200" $ do
resp <- get "/"
liftIO $ responseStatus resp `shouldBe` ok200

Types and functions for testing wai endpoints using the tasty testing framework.

A light-weight wrapper around Network.Wai to provide easy pipes support.

This module provides remote monitoring of a running process over HTTP. It can be used to run an HTTP server that provides both a web-based user interface and a machine-readable API (e.g. JSON.) The former can be used by a human to get an overview of what the program is doing and the latter can be used by automated monitoring tools. Typical usage is to start the monitoring server at program startup

main = do
forkServer "localhost" 8000
...

and then periodically check the stats using a web browser or a command line tool (e.g. curl)

$ curl -H "Accept: application/json" http://localhost:8000/

Add information about the Request, Response, and the response time to Katip's LogContexts. Example setup:

import Control.Exception (bracket)
import Data.Proxy (Proxy (Proxy))
import Katip qualified
import Katip.Wai (ApplicationT, runApplication)
import Katip.Wai qualified
import Network.Wai.Handler.Warp qualified as Warp
import Servant qualified
import System.IO (stdout)
import UnliftIO (MonadUnliftIO (withRunInIO))


type Api = Servant.GetNoContent


server :: Servant.ServerT Api (Katip.KatipContextT Servant.Handler)
server = do
Katip.logLocM Katip.InfoS "This message should also have the request context"
pure Servant.NoContent


mkApplication :: ApplicationT (Katip.KatipContextT IO)
mkApplication = Katip.Wai.middleware Katip.InfoS $ request send -> do
logEnv <- Katip.getLogEnv
context <- Katip.getKatipContext
namespace <- Katip.getKatipNamespace

let hoistedApp =
let proxy = Proxy @Api
hoistedServer = Servant.hoistServer proxy (Katip.runKatipContextT logEnv context namespace) server
in Servant.serve proxy hoistedServer

withRunInIO $ toIO -> hoistedApp request (toIO . send)


withLogEnv :: (Katip.LogEnv -> IO a) -> IO a
withLogEnv useLogEnv = do
handleScribe <-
Katip.mkHandleScribeWithFormatter
Katip.jsonFormat
(Katip.ColorLog False)
stdout
(Katip.permitItem minBound)
Katip.V3

let makeLogEnv =
Katip.initLogEnv "example-app" "local-dev"
>>= Katip.registerScribe "stdout" handleScribe Katip.defaultScribeSettings

bracket makeLogEnv Katip.closeScribes useLogEnv


main :: IO ()
main = withLogEnv $ logEnv ->
let
app = runApplication (Katip.runKatipContextT logEnv () "main") mkApplication
in
Warp.run 5555 app

Example output:

{"app":["example-app"],"at":"2024-09-07T18:44:10.411097829Z","data":{"request":{"headers":{Host:"localhost:5555","User-Agent":"curl8.9.1"},"httpVersion":"HTTP1.1","id":"7ec0fbc4-722c-4c70-a168-c2abe5c7b4fa","isSecure":false,"method":GET,"path":"/","queryString":[],"receivedAt":"2024-09-07T18:44:10.411057334Z","remoteHost":"127.0.0.1:51230"}},"env":"local-dev","host":"x1g11","loc":null,"msg":"Request received.","ns":["example-app","main"],"pid":"106249","sev":Info,"thread":"27"}
{"app":["example-app"],"at":"2024-09-07T18:44:10.411097829Z","data":{"request":{"headers":{Host:"localhost:5555","User-Agent":"curl8.9.1"},"httpVersion":"HTTP1.1","id":"7ec0fbc4-722c-4c70-a168-c2abe5c7b4fa","isSecure":false,"method":GET,"path":"","queryString":[],"receivedAt":"2024-09-07T18:44:10.411057334Z","remoteHost":"127.0.0.1:51230"}},"env":"local-dev","host":"x1g11","loc":{"loc_col":3,"loc_fn":"srcKatipWaiExample/Short.hs","loc_ln":19,"loc_mod":Katip.Wai.Example.Short,"loc_pkg":"my-katip-wai-example-0.1.0.0-inplace"},"msg":"This message should also have the request context","ns":["example-app","main"],"pid":"106249","sev":Info,"thread":"27"}
{"app":["example-app"],"at":"2024-09-07T18:44:10.411097829Z","data":{"request":{"headers":{Host:"localhost:5555","User-Agent":"curl8.9.1"},"httpVersion":"HTTP1.1","id":"7ec0fbc4-722c-4c70-a168-c2abe5c7b4fa","isSecure":false,"method":GET,"path":"/","queryString":[],"receivedAt":"2024-09-07T18:44:10.411057334Z","remoteHost":"127.0.0.1:51230"},"response":{"headers":{},"respondedAt":"2024-09-07T18:44:10.411199014Z","responseTime":{"time":0.137369,"unit":"ms"},"status":{"code":204,"message":"No Content"}}},"env":"local-dev","host":"x1g11","loc":null,"msg":"Response sent.","ns":["example-app","main"],"pid":"106249","sev":Info,"thread":"27"}

This file is a ported to Haskell language code with some simplifications of rack-attack https://github.com/rack/rack-attack/blob/main/lib/rack/attack.rb and is based on the structure of the original code of rack-attack, Copyright (c) 2016 by Kickstarter, PBC, under the MIT License. Oleksandr Zhabenko added several implementations of the window algorithm: tinyLRU, sliding window, token bucket window, leaky bucket window alongside with the initial count algorithm using AI chatbots. IP Zone functionality added to allow separate caches per IP zone. Overview ======== This module provides WAI middleware for declarative, IP-zone-aware rate limiting with multiple algorithms:

• Fixed Window
• Sliding Window
• Token Bucket
• Leaky Bucket
• TinyLRU

Key points ----------

• Plugin-friendly construction: build an environment once (Env) from RateLimiterConfig and produce a pure WAI Middleware. This matches common WAI patterns and avoids per-request setup or global mutable state.
• Concurrency model: all shared structures inside Env use STM TVar, not IORef. This ensures thread-safe updates under GHC's lightweight (green) threads.
• Zone-specific caches: per-IP-zone caches are stored in a HashMap keyed by zone identifiers. Zones are derived from a configurable strategy (ZoneBy), with a default.
• No global caches in Keter: you can build one Env per compiled middleware chain and cache that chain externally (e.g., per-vhost + middleware-list), preserving counters/windows across requests.

Quick start ----------- 1) Declarative configuration (e.g., parsed from JSON/YAML):

let cfg = RateLimiterConfig
{ rlZoneBy = ZoneDefault
, rlThrottles =
[ RLThrottle "api"   1000 3600 FixedWindow IdIP Nothing
, RLThrottle "login" 5    300  TokenBucket IdIP (Just 600)
]
}

2) Build Env once and obtain a pure Middleware:

env <- buildEnvFromConfig cfg
let mw = buildRateLimiterWithEnv env
app = mw baseApplication

Alternatively:

mw <- buildRateLimiter cfg  -- convenience: Env creation + Middleware
app = mw baseApplication

Usage patterns -------------- Declarative approach (recommended):

import Keter.RateLimiter.WAI
import Keter.RateLimiter.Cache (Algorithm(..))

main = do
let config = RateLimiterConfig
{ rlZoneBy = ZoneIP
, rlThrottles = 
[ RLThrottle "api" 100 3600 FixedWindow IdIP Nothing
]
}
middleware <- buildRateLimiter config
let app = middleware baseApp
run 8080 app

Programmatic approach (advanced):

import Keter.RateLimiter.WAI
import Keter.RateLimiter.Cache (Algorithm(..))

main = do
env initConfig (\req - "zone1")
let throttleConfig = ThrottleConfig
{ throttleLimit = 100
, throttlePeriod = 3600
, throttleAlgorithm = FixedWindow
, throttleIdentifierBy = IdIP
, throttleTokenBucketTTL = Nothing
}
env' <- addThrottle env "api" throttleConfig
let middleware = buildRateLimiterWithEnv env'
app = middleware baseApp
run 8080 app

Configuration reference ----------------------- Client identification strategies (IdentifierBy):

• IdIP - Identify by client IP address
• IdIPAndPath - Identify by IP address and request path
• IdIPAndUA - Identify by IP address and User-Agent header
• IdHeader headerName - Identify by custom header value
• IdCookie cookieName - Identify by cookie value
• IdHeaderAndIP headerName - Identify by header value combined with IP

Zone derivation strategies (ZoneBy):

• ZoneDefault - All requests use the same cache (no zone separation)
• ZoneIP - Separate zones by client IP address
• ZoneHeader headerName - Separate zones by custom header value

Rate limiting algorithms:

• FixedWindow - Traditional fixed-window counting
• SlidingWindow - Precise sliding-window with timestamp tracking
• TokenBucket - Allow bursts up to capacity, refill over time
• LeakyBucket - Smooth rate limiting with configurable leak rate
• TinyLRU - Least-recently-used eviction for memory efficiency

wai-session server-side session support. Please note that this frontend has some limitations:

• Cookies use the Max-age field instead of Expires. The Max-age field is not supported by all browsers: some browsers will treat them as non-persistent cookies.
• Also, the Max-age is fixed and does not take a given session into consideration.

Module for using a WAI Middleware as an X-Ray client

Web Application Interface. Provides a common protocol for communication between web applications and web servers. API docs and the README are available at http://www.stackage.org/package/wai.

Wrap up a normal WAI application as a Yesod subsite. Ignore parent site's middleware and isAuthorized.

Like WaiSubsite, but applies parent site's middleware and isAuthorized.