WAI

https://github.com/yesodweb/wai
Admin
WAI is an interface between Haskell web frameworks and web servers that enables modular,...
Tokens:9,229
Snippets:59
Trust Score:6.9
License:MIT
Update:10 months ago
Show doc for...
Tokens:
Raw
### Basic Warp Server Startup Examples

Source: https://context7.com/yesodweb/wai/llms.txt

Demonstrates three ways to start a Warp server: on a fixed port, using the PORT environment variable, and with custom settings. These examples show basic `run` and `runEnv` functions, as well as configuring `defaultSettings` with options like port, host, timeout, and server name.

```haskell
import Network.Wai.Handler.Warp

-- Run on fixed port
simpleMain :: IO ()
simpleMain = run 8080 app

-- Use PORT environment variable (defaults to 8080 if not set)
envMain :: IO ()
envMain = runEnv 8080 app

-- Custom settings with multiple configurations
customMain :: IO ()
customMain = do
    let settings = setPort 3000
                 $ setHost "127.0.0.1"  -- localhost only
                 $ setTimeout 60        -- 60 second timeout
                 $ setServerName "MyApp/1.0"
                 $ setBeforeMainLoop (putStrLn "Server ready!")
                 $ defaultSettings
    runSettings settings app
```

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

### Basic WAI Application Setup in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Demonstrates a minimal WAI application that responds to requests with 'Hello, Web!'. It utilizes Network.Wai and Network.HTTP.Types for request handling and response construction, and Network.Wai.Handler.Warp to run the server.

```haskell
{-# LANGUAGE OverloadedStrings #}
import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)

-- Simple application responding with "Hello, Web!"
app :: Application
app request respond = do
    putStrLn "Processing request"
    respond $ responseLBS
        status200
        [("Content-Type", "text/plain")]
        "Hello, Web!"

main :: IO ()
main = do
    putStrLn "Server starting on http://localhost:8080"
    run 8080 app
```

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

### Example Haskell API Documentation

Source: https://github.com/yesodweb/wai/blob/master/CONTRIBUTING.md

Provides an example of Haddock documentation for a Haskell function, including a description, usage example, and version information. This follows the required documentation standards for public APIs.

```haskell
-- | Generate an action which will either read from an automatically
-- updated value, or run the update action in the current thread.
--
-- ==== __Examples__
--
-- > getTime <- mkAutoUpdate defaultUpdateSettings
--
-- @since 0.1.0
mkAutoUpdate :: UpdateSettings a -> IO (IO a)
```

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

### Serve Static Files with WAI

Source: https://context7.com/yesodweb/wai/llms.txt

Demonstrates how to serve static files using WAI's static application. Includes basic setup, custom settings for caching and directory listings, and integration into a hybrid application.

```haskell
import Network.Wai.Application.Static
import Network.Wai.Handler.Warp
import WaiAppStatic.Types

-- Basic static file server
staticServer :: IO ()
staticServer = run 8080 $ staticApp (defaultWebAppSettings "public")

-- Custom static settings with caching and indices
customStaticServer :: IO ()
customStaticServer = run 8080 $ staticApp settings
  where
    settings = (defaultFileServerSettings "static")
        { ssIndices = [unsafeToPiece "index.html", unsafeToPiece "index.htm"]
        , ssMaxAge = MaxAgeSeconds 3600  -- Cache for 1 hour
        , ssRedirectToIndex = True
        , ssAddTrailingSlash = True
        , ssListing = Just defaultListing  -- Enable directory listing
        , ss404Handler = Just custom404
        }

    custom404 _ respond = respond $ responseLBS
        status404
        [("Content-Type", "text/html")]
        "<h1>404 - Page Not Found</h1>"

-- Combined static and dynamic app
hybridApp :: Application
hybridApp request respond =
    case pathInfo request of
        ("api":_) -> apiApp request respond
        _ -> staticApp (defaultWebAppSettings "public") request respond
  where
    apiApp = undefined  -- Your API implementation

```

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

### HTTP/2 Server Push Configuration with WAI

Source: https://context7.com/yesodweb/wai/llms.txt

Explains how to implement HTTP/2 Server Push using the WAI library. The example application `http2App` demonstrates how to define `PushPromise` objects for resources like CSS and JavaScript files. These promises are added to the HTTP/2 data associated with the request, allowing the server to proactively send these resources to the client.

```haskell
import Network.Wai
import Network.Wai.Handler.Warp

-- Application with HTTP/2 server push
http2App :: Application
http2App request respond = do
    -- Create push promises for resources
    let pushPromises =
            [ defaultPushPromise
                { promisedPath = "/style.css"
                , promisedFile = "static/style.css"
                , promisedResponseHeaders = [("Content-Type", "text/css")]
                , promisedWeight = 16
                }
            , defaultPushPromise
                { promisedPath = "/script.js"
                , promisedFile = "static/script.js"
                , promisedResponseHeaders = [("Content-Type", "application/javascript")]
                , promisedWeight = 16
                }
            ]

    -- Get current HTTP/2 data and add push promises
    http2data <- getHTTP2Data request
    setHTTP2Data request $ http2data { http2dataPushPromise = pushPromises }

    -- Respond with HTML page
    respond $ responseLBS
        status200
        [("Content-Type", "text/html")]
        "<html><head><link rel=\"stylesheet\" href=\"/style.css\"></head></html>"

main :: IO ()
main = run 8080 http2App
```

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

### Stacking Middleware in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Demonstrates how to stack multiple WAI middleware layers in Haskell. Middleware is applied in reverse order of definition (outer executes first). This example includes logging, compression, CORS headers, method override, automatic HEAD handling, and a health check.

```haskell
import Network.Wai
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Gzip
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.MethodOverride

-- Complete middleware stack (outer middleware executes first)
fullApp :: Application
fullApp =
    logStdout $              -- 1. Log all requests
    gzip def $               -- 2. Compress responses
    addCorsHeaders $         -- 3. Add CORS headers
    methodOverride $         -- 4. Support _method parameter
    autohead $               -- 5. Handle HEAD requests automatically
    healthCheck $            -- 6. Health check endpoint
    baseApp                  -- 7. Your application
  where
    addCorsHeaders = addHeaders
        [ ("Access-Control-Allow-Origin", "*")
        , ("Access-Control-Allow-Methods", "GET, POST, PUT, DELETE, OPTIONS")
        , ("Access-Control-Allow-Headers", "Content-Type, Authorization")
        ]

    healthCheck = ifRequest isHealthCheck healthCheckApp id
    isHealthCheck req = rawPathInfo req == "/health"
    healthCheckApp _ respond = respond $ responseLBS status200 [] "OK"

-- Alternative composition using function composition
fullApp' :: Application
fullApp' = logStdout . gzip def . addCorsHeaders . methodOverride . autohead $ baseApp
```

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

### Test WAI App with Custom Warp Settings

Source: https://context7.com/yesodweb/wai/llms.txt

This example demonstrates how to test a WAI application using custom Warp server settings. It configures the server to use a random available port and sets a hook to run before the main loop, useful for controlling test environments.

```haskell
import Network.Wai.Handler.Warp
import Network.HTTP.Client
import Test.Hspec

-- Custom settings for testing
testWithCustomSettings :: IO ()
testWithCustomSettings =
    withApplicationSettings settings (return app) $ \port -> do
        putStrLn $ "Test server running on port " ++ show port
        -- Run your tests
  where
    settings = setBeforeMainLoop (return ()) 
             $ setPort 0  -- Use any available port
             $ defaultSettings
```

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

### Run Basic TLS/HTTPS Server with Warp

Source: https://context7.com/yesodweb/wai/llms.txt

Configures and runs a Warp server with TLS/HTTPS enabled using certificate and key files. This is the fundamental setup for secure web communication.

```haskell
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS

-- Basic TLS server with certificate files
tlsServer :: IO ()
tlsServer = runTLS tlsSettings warpSettings app
  where
    tlsSettings = tlsSettings "certificate.pem" "key.pem"
    warpSettings = setPort 443 defaultSettings

```

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

### Test WAI App GET Request with Warp

Source: https://context7.com/yesodweb/wai/llms.txt

This snippet demonstrates how to test a WAI application's response to a GET request using Warp's testing utilities. It involves launching the application on a random port, making an HTTP GET request using http-client, and asserting the response status code.

```haskell
import Network.Wai.Handler.Warp
import Network.HTTP.Client
import Test.Hspec

testApp :: Spec
testApp = do
    describe "WAI Application" $ do
        it "responds to GET /" $ do
            withApplication (return app) $ \port -> do
                manager <- newManager defaultManagerSettings
                request <- parseRequest $ "http://localhost:" ++ show port ++ "/"
                response <- httpLbs request manager
                responseStatus response `shouldBe` status200
```

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

### WAI Request Routing with Path Matching in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Provides an example of a WAI application that routes incoming requests based on their HTTP method and path information. It handles different routes for home, API endpoints, static file serving, and a fallback 404 response.

```haskell
import qualified Data.Text as T
import Network.Wai
import Network.HTTP.Types

routedApp :: Application
routedApp request respond = 
    case (requestMethod request, pathInfo request) of
        ("GET", []) ->
            respond $ responseLBS status200 [("Content-Type", "text/html")] "<h1>Home</h1>"

        ("GET", ["api", "users"]) ->
            respond $ responseLBS status200 [("Content-Type", "application/json")]
                "{\"users\": [\"alice\", \"bob\"]}"

        ("POST", ["api", "users"]) -> do
            body <- strictRequestBody request
            respond $ responseLBS status201 [("Content-Type", "application/json")]
                $ "{\"created\": true, \"body\": " <> body <> "}"

        ("GET", ["static", filename]) ->
            respond $ responseFile status200 [] ("static/" ++ unpack filename) Nothing

        _ ->
            respond $ responseLBS status404 [] "404 - Not Found"
  where
    unpack = T.unpack
```

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

### Build Wai Subprojects with Stack

Source: https://github.com/yesodweb/wai/blob/master/CONTRIBUTING.md

Demonstrates how to use Stack to build and test individual Haskell packages within the Wai mega-repo. This allows for targeted development and testing of specific subprojects.

```bash
stack build mime-types
stack test auto-update
stack haddock warp
```

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

### Minimal Haskell WAI Application

Source: https://github.com/yesodweb/wai/blob/master/wai/README.md

A basic 'Hello, World!' web application using WAI and Warp. It sets up a simple HTTP server that responds with plain text. Dependencies include 'wai' and 'warp'.

```haskell
{-# LANGUAGE OverloadedStrings }
import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)

app :: Application
app _ respond = do
    putStrLn "I've done some IO here"
    respond $ responseLBS
        status200
        [("Content-Type", "text/plain")]
        "Hello, Web!"

main :: IO ()
main = do
    putStrLn $ "http://localhost:8080/"
    run 8080 app

```

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

### Basic Request Dispatching in WAI

Source: https://github.com/yesodweb/wai/blob/master/wai/README.md

Demonstrates how to dispatch different responses based on the request path. It maps '/', '/raw/', and other paths to specific responses ('index', 'plainIndex', 'notFound').

```haskell
app3 :: Application
app3 request respond = respond $ case rawPathInfo request of
    "/"     -> index
    "/raw/" -> plainIndex
    _       -> notFound

plainIndex :: Response
plainIndex = responseFile
    status200
    [("Content-Type", "text/plain")]
    "index.html"
    Nothing

notFound :: Response
notFound = responseLBS
    status404
    [("Content-Type", "text/plain")]
    "404 - Not Found"

```

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

### WAI Response Construction in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Illustrates various ways to construct WAI responses, including serving static files, partial file content, builder-based responses for efficient concatenation, and streaming responses for dynamic content generation.

```haskell
import qualified Data.ByteString.Builder as Builder
import Network.Wai
import Network.HTTP.Types
import Control.Concurrent (threadDelay)

-- Serve a file directly
fileResponse :: Response
fileResponse = responseFile
    status200
    [("Content-Type", "text/html")]
    "index.html"
    Nothing  -- Serve entire file

-- Serve partial file (byte range)
partialFileResponse :: Response
partialFileResponse = responseFile
    status206
    [("Content-Type", "video/mp4"),
     ("Content-Range", "bytes 0-1023/5000")]
    "video.mp4"
    (Just $ FilePart 0 1024 5000)

-- Builder-based response (efficient for concatenation)
builderResponse :: Response
builderResponse = responseBuilder
    status200
    [("Content-Type", "text/plain")]
    (Builder.byteString "Hello " <> Builder.byteString "World")

-- Streaming response with chunked data
streamingResponse :: Response
streamingResponse = responseStream status200 [("Content-Type", "text/plain")] $ \write flush -> do
    write $ Builder.byteString "Chunk 1\n"
    flush
    threadDelay 1000000
    write $ Builder.byteString "Chunk 2\n"
    flush
```

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

### Configure Stack for Local Wai Development

Source: https://github.com/yesodweb/wai/blob/master/CONTRIBUTING.md

Shows how to configure your Stack project to build against a local copy of the Wai repository. This is useful for testing changes in a full-fledged Wai application.

```yaml
packages:
- '/path/to/this/repo/wai'
```

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

### Serving Static HTML Content with WAI

Source: https://github.com/yesodweb/wai/blob/master/wai/README.md

Modifies a WAI application to serve static HTML content from a file. It defines an 'index' response that points to 'index.html'. Requires a pre-existing 'index.html' file.

```haskell
app2 :: Application
app2 _ respond = respond index

index :: Response
index = responseFile
    status200
    [("Content-Type", "text/html")]
    "index.html"
    Nothing

```

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

### Advanced Warp Server Settings and Exception Handling

Source: https://context7.com/yesodweb/wai/llms.txt

Details advanced server configurations including exception handling, connection lifecycle callbacks, and graceful shutdown. It shows how to set custom exception handlers, response generators for errors, and callbacks for connection opening and closing. The `productionSettings` function demonstrates these advanced options, along with signal handling for graceful termination.

```haskell
import Network.Wai.Handler.Warp
import Control.Exception
import System.Posix.Signals (installHandler, Handler(Catch), sigTERM)
import qualified Data.ByteString.Char8 as BS

productionSettings :: IO Settings
productionSettings = do
    let settings = setPort 8080
                 $ setHost "*6"  -- IPv6 any address
                 $ setTimeout 30
                 $ setOnException exceptionHandler
                 $ setOnExceptionResponse exceptionResponseHandler
                 $ setOnOpen connectionOpen
                 $ setOnClose connectionClose
                 $ setGracefulShutdownTimeout (Just 30)
                 $ setInstallShutdownHandler shutdownHandler
                 $ setHTTP2Disabled  -- Disable HTTP/2 if needed
                 $ setMaxTotalHeaderLength 50000
                 $ setFdCacheDuration 10  -- Enable FD cache for static files
                 $ defaultSettings
    return settings
  where
    exceptionHandler :: Maybe Request -> SomeException -> IO ()
    exceptionHandler mreq ex = do
        putStrLn $ "Exception: " ++ show ex
        case mreq of 
            Nothing -> putStrLn "No request context"
            Just req -> putStrLn $ "Path: " ++ show (rawPathInfo req)

    exceptionResponseHandler :: SomeException -> Response
    exceptionResponseHandler ex = responseLBS
        status500
        [("Content-Type", "text/plain")]
        ("Internal Server Error: " <> BS.pack (show ex))

    connectionOpen :: SockAddr -> IO Bool
    connectionOpen addr = do
        putStrLn $ "Connection opened: " ++ show addr
        return True  -- Accept connection

    connectionClose :: SockAddr -> IO ()
    connectionClose addr = putStrLn $ "Connection closed: " ++ show addr

    shutdownHandler :: IO () -> IO ()
    shutdownHandler closeSocket = void $ 
        installHandler sigTERM (Catch $ closeSocket) Nothing

-- Run with production settings
main :: IO ()
main = do
    settings <- productionSettings
    runSettings settings app
```

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

### Configure Production and Development Logging in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Set up different logging configurations for development and production environments using WAI's request logging middleware. This includes colorful, detailed logs for development and Apache-style logs for production, with options for custom logging.

```haskell
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Handler.Warp

-- Development logging with colors and details
devApp :: Application
devApp = logStdoutDev $ baseApp

-- Production Apache-style logging
prodApp :: Application
prodApp = logStdout $ baseApp

-- Custom logging configuration
customLoggingApp :: IO Application
customLoggingApp = do
    logger <- mkRequestLogger $ defaultRequestLoggerSettings
        {
          outputFormat = ApacheWithSettings $ 
            setApacheIPAddrSource FromHeader $ 
            setApacheRequestFilter (\req res -> responseStatus res /= status200) $ 
            setApacheUserGetter getUserFromRequest $ 
            defaultApacheSettings
        ,
          destination = Handle stdout
        ,
          autoFlush = True
        }
    return $ logger baseApp
  where
    getUserFromRequest req = lookup "X-User-ID" (requestHeaders req)

main :: IO ()
main = run 8080 =<< customLoggingApp
```

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

### Run TLS/HTTPS Server with In-Memory Certificates

Source: https://context7.com/yesodweb/wai/llms.txt

Establishes a TLS/HTTPS server using certificates and keys loaded directly into memory from files. This is useful for testing scenarios or when certificates are dynamically generated.

```haskell
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS
import qualified Data.ByteString.Char8 as BS

-- TLS with in-memory certificates (useful for testing or dynamic certs)
memoryTlsServer :: IO ()
memoryTlsServer = do
    certData <- BS.readFile "cert.pem"
    keyData <- BS.readFile "key.pem"
    runTLS (tlsSettingsMemory certData keyData) (setPort 443 defaultSettings) app

```

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

### Warp Connection Counter and Monitoring

Source: https://context7.com/yesodweb/wai/llms.txt

Shows how to monitor the number of active connections to a Warp server. It utilizes `makeSettingsAndCounter` to create server settings along with a connection counter object. A background thread is spawned to periodically fetch and print the current connection count.

```haskell
import Network.Wai.Handler.Warp
import Control.Concurrent (threadDelay, forkIO)

monitoredServer :: IO ()
monitoredServer = do
    -- Create settings with connection counter
    (settings, counter) <- makeSettingsAndCounter defaultSettings

    -- Background thread to monitor connections
    forkIO $ forever $ do
        count <- getCount counter
        putStrLn $ "Active connections: " ++ show count
        threadDelay 5000000  -- Check every 5 seconds

    -- Run server
    runSettings settings app
```

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

### Run TLS/HTTPS Server with Certificate Chain

Source: https://context7.com/yesodweb/wai/llms.txt

Sets up a TLS/HTTPS server using a certificate chain, which includes intermediate certificates. This is crucial for ensuring broad client compatibility and trust.

```haskell
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS

-- TLS with certificate chain
chainTlsServer :: IO ()
chainTlsServer = runTLS tlsSettings warpSettings app
  where
    tlsSettings = tlsSettingsChain
        "cert.pem"
        ["intermediate1.pem", "intermediate2.pem"]
        "key.pem"
    warpSettings = setPort 443 defaultSettings

```

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

### Test WAI App POST Request with Warp

Source: https://context7.com/yesodweb/wai/llms.txt

This snippet illustrates testing a WAI application's handling of POST requests. It shows how to configure a POST request with a JSON body and specific headers, send it to the application running on a test port, and verify the response status code.

```haskell
import Network.Wai.Handler.Warp
import Network.HTTP.Client
import Test.Hspec

testApp :: Spec
testApp = do
    describe "WAI Application" $ do
        it "handles POST requests" $ do
            testWithApplication (return app) $ \port -> do
                manager <- newManager defaultManagerSettings
                let reqBody = "{\"name\": \"test\"}"
                initReq <- parseRequest $ "http://localhost:" ++ show port ++ "/api/users"
                let request = initReq
                        { method = "POST"
                        , requestBody = RequestBodyLBS reqBody
                        , requestHeaders = [("Content-Type", "application/json")]
                        }
                response <- httpLbs request manager
                responseStatus response `shouldBe` status201
```

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

### Implement Gzip Compression Middleware in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Apply gzip compression to WAI responses using the `Network.Wai.Middleware.Gzip` module. This middleware can be used with default settings for basic compression or configured with custom options for cache folders, MIME type filtering, and size thresholds.

```haskell
import Network.Wai.Middleware.Gzip

-- Basic gzip with defaults
gzipApp :: Application
gzipApp = gzip def baseApp

-- Custom gzip settings
advancedGzipApp :: Application
advancedGzipApp = gzip settings baseApp
  where
    settings = defaultGzipSettings
    settings' = gzipFiles (GzipCacheFolder "/tmp/gzip-cache") settings
    settings'' = gzipCheckMime (\mime -> mime `elem` compressibleTypes) settings'
    settings''' = gzipSizeThreshold 1024 settings''  -- Only compress >= 1KB

    compressibleTypes = 
        ["text/html"
        ,"text/css"
        ,"application/javascript"
        ,"application/json"
        ]

-- Use pre-compressed files if available
precompressedApp :: Application
precompressedApp = gzip (gzipFiles (GzipPreCompressed GzipIgnore) defaultGzipSettings) baseApp
```

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

### Run TLS Server with SNI Certificate Selection

Source: https://context7.com/yesodweb/wai/llms.txt

Implements a TLS server that selects certificates based on the Server Name Indication (SNI) extension. This allows serving multiple domains from a single IP address with different SSL certificates.

```haskell
import Network.Wai.Handler.WarpTLS
import qualified Network.TLS as TLS

-- SNI-based certificate selection
sniTlsServer :: IO ()
sniTlsServer = runTLS tlsSettings warpSettings app
  where
    tlsSettings = tlsSettingsSni getCertForHost

    getCertForHost :: Maybe TLS.HostName -> IO TLS.Credentials
    getCertForHost Nothing = loadDefaultCert
    getCertForHost (Just hostname) = case hostname of
        "example.com" -> TLS.credentialLoadX509Chain
            "certs/example.com.pem"
            ["certs/example-chain.pem"]
            "certs/example.com.key"
        "api.example.com" -> TLS.credentialLoadX509Chain
            "certs/api.example.com.pem"
            []
            "certs/api.example.com.key"
        _ -> loadDefaultCert

    loadDefaultCert = TLS.credentialLoadX509Chain
        "certs/default.pem" [] "certs/default.key"

    warpSettings = setPort 443 $ setHost "0.0.0.0" defaultSettings

```

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

### Create Custom Log Formatters in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Define custom output formats for WAI request logs using `OutputFormatterWithDetailsAndHeaders`. This allows for detailed logging of request and response information, including dates, methods, paths, status codes, durations, sizes, and custom headers like user IDs.

```haskell
import Network.Wai.Middleware.RequestLogger
import System.Log.FastLogger

customFormatter :: OutputFormatterWithDetailsAndHeaders
customFormatter date req status msize duration reqBody rawResponse resHeaders = 
    toLogStr (show date) <> " | " <> 
    toLogStr (requestMethod req) <> " " <> 
    toLogStr (rawPathInfo req) <> " | " <> 
    "Status: " <> toLogStr (show status) <> " | " <> 
    "Duration: " <> toLogStr (show duration) <> " | " <> 
    "Size: " <> toLogStr (show msize) <> " | " <> 
    "User: " <> toLogStr (fromMaybe "-" $ lookup "X-User-ID" resHeaders) <> 
    "\n"

customLoggerApp :: IO Application
customLoggerApp = do
    logger <- mkRequestLogger $ defaultRequestLoggerSettings
        {
          outputFormat = CustomOutputFormatWithDetailsAndHeaders customFormatter
        }
    return $ logger baseApp
```

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

### WebSocket Server with Fallback in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Integrates WebSocket functionality into a WAI application using `Network.Wai.Handler.WebSockets`. It sets up a WebSocket echo server and provides an HTTP fallback for non-WebSocket requests. Requires `OverloadedStrings`.

```haskell
{-# LANGUAGE OverloadedStrings #}
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WebSockets
import qualified Network.WebSockets as WS
import Control.Concurrent (forkIO)
import Control.Monad (forever)

-- WebSocket echo server
wsApp :: WS.ServerApp
wsApp pending = do
    conn <- WS.acceptRequest pending
    putStrLn "WebSocket connection established"

    -- Send welcome message
    WS.sendTextData conn ("Welcome to the WebSocket server!" :: Text)

    -- Echo loop
    forever $ do
        msg <- WS.receiveData conn
        putStrLn $ "Received: " ++ show (msg :: Text)
        WS.sendTextData conn msg

-- HTTP fallback application
httpApp :: Application
httpApp _ respond = respond $ responseLBS
    status400
    [("Content-Type", "text/plain")]
    "This is a WebSocket endpoint. Use ws:// or wss:// protocol."

-- Combined application
app :: Application
app = websocketsOr WS.defaultConnectionOptions wsApp httpApp

main :: IO ()
main = do
    putStrLn "WebSocket server running on ws://localhost:8080"
    run 8080 app
```

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

### Run Mixed HTTP and HTTPS Servers

Source: https://context7.com/yesodweb/wai/llms.txt

Configures a server to run both HTTP and HTTPS services simultaneously. The HTTP service is set up to redirect all incoming requests to the HTTPS service for enhanced security.

```haskell
import Network.Wai.Handler.WarpTLS
import Network.Wai
import Data.Maybe (fromMaybe)

-- Mixed HTTP/HTTPS server
mixedServer :: IO ()
mixedServer = do
    -- HTTPS on 443
    forkIO $ runTLS
        (tlsSettings "cert.pem" "key.pem")
        (setPort 443 defaultSettings)
        app

    -- HTTP on 80 (redirects to HTTPS)
    run 80 redirectToHttps
  where
    redirectToHttps req respond = respond $ responseLBS
        status301
        [("Location", "https://" <> fromMaybe "localhost" (requestHeaderHost req) <> rawPathInfo req)]
        ""

```

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

### WAI Response without Overloaded Strings

Source: https://github.com/yesodweb/wai/blob/master/wai/README.md

A more verbose definition of the 'notFound' response in WAI, explicitly handling bytestrings without relying on GHC's 'OverloadedStrings' extension. It uses qualified imports for 'bytestring' and 'case-insensitive' packages.

```haskell
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as LB8
import           Data.CaseInsensitive (mk)

notFound = responseLBS
    status404
    [(mk $ B8.pack "Content-Type", B8.pack "text/plain")]
    (LB8.pack "404 - Not Found")

```

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

### Conditional Middleware in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Shows how to apply WAI middleware conditionally based on request properties in Haskell. Middleware can be selectively applied to specific routes (e.g., API routes) or based on request characteristics (e.g., authentication status).

```haskell
import Network.Wai

-- Apply middleware only to API routes
apiOnlyMiddleware :: Middleware -> Middleware
apiOnlyMiddleware mw = ifRequest isApiRoute mw
  where
    isApiRoute req = case pathInfo req of
        ("api":_) -> True
        _ -> False

-- Different middleware for authenticated users
conditionalApp :: Application
conditionalApp =
    ifRequest isAuthenticated authenticatedMiddleware $
    ifRequest isPublic publicMiddleware $
    baseApp
  where
    isAuthenticated req = isJust $ lookup "Authorization" (requestHeaders req)
    isPublic req = pathInfo req `elem` [[], ["public"], ["login"], ["register"]]

    authenticatedMiddleware = logStdout . gzip def
    publicMiddleware = addHeaders [("Cache-Control", "public, max-age=3600")]
```

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

### WebSocket Chat Server in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Implements a multi-client WebSocket chat server using `Network.WebSockets` and STM for state management. Clients broadcast messages to each other, and new clients are assigned unique IDs.

```haskell
import qualified Network.WebSockets as WS
import Control.Concurrent.STM
import qualified Data.Text as T

type Client = (Int, WS.Connection)
type ServerState = TVar [Client]

chatServer :: ServerState -> WS.ServerApp
chatServer state pending = do
    conn <- WS.acceptRequest pending
    clientId <- atomically $ do
        clients <- readTVar state
        let newId = length clients + 1
        writeTVar state ((newId, conn) : clients)
        return newId

    putStrLn $ "Client " ++ show clientId ++ " connected"

    -- Handle incoming messages
    handle conn $ do
        WS.withPingThread conn 30 (return ()) $ forever $ do
            msg <- WS.receiveData conn
            broadcast state clientId msg
  where
    disconnect clientId = atomically $ modifyTVar state (filter ((/= clientId) . fst))

    broadcast state senderId msg = do
        clients <- atomically $ readTVar state
        forM_ clients $ \(clientId, conn) ->
            when (clientId /= senderId) $ 
                WS.sendTextData conn (T.pack $ "User " ++ show senderId ++ ": " ++ T.unpack msg)

main :: IO ()
main = do
    state <- newTVarIO []
    let app = websocketsOr WS.defaultConnectionOptions (chatServer state) httpApp
    run 8080 app
```

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

### Add Security Headers and Force SSL in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Enhance web application security by adding common security headers like `X-Frame-Options`, `X-Content-Type-Options`, and `Strict-Transport-Security` using `Network.Wai.Middleware.AddHeaders`. Also, enforce HTTPS connections by redirecting HTTP requests to HTTPS using `Network.Wai.Middleware.ForceSSL`.

```haskell
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Middleware.ForceSSL
import Network.Wai.Middleware.HttpAuth

-- Add security headers
secureHeadersApp :: Application
secureHeadersApp = addHeaders securityHeaders $ baseApp
  where
    securityHeaders = 
        [ ("X-Frame-Options", "DENY")
        , ("X-Content-Type-Options", "nosniff")
        , ("X-XSS-Protection", "1; mode=block")
        , ("Strict-Transport-Security", "max-age=31536000; includeSubDomains")
        , ("Content-Security-Policy", "default-src 'self'")
        ]

-- Force HTTPS redirection
sslApp :: Application
sslApp = forceSSL $ baseApp

-- HTTP Basic Authentication
authApp :: Application
authApp = basicAuth checkCredentials "Restricted Area" baseApp
  where
    checkCredentials :: ByteString -> ByteString -> IO Bool
    checkCredentials username password = do
        -- Check against database or predefined credentials
        return $ username == "admin" && password == "secret"

-- Combine multiple security middleware
productionSecureApp :: Application
productionSecureApp = 
    addHeaders securityHeaders $
    forceSSL $
    basicAuth checkCreds "Admin" $ 
    baseApp
```

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

### WAI Request Body Handling in Haskell

Source: https://context7.com/yesodweb/wai/llms.txt

Shows two methods for handling request bodies in WAI: `strictRequestBody` for reading the entire body at once, and `getRequestBodyChunk` for processing data in chunks using streaming.

```haskell
import qualified Data.ByteString.Lazy as L
import Network.Wai
import Network.HTTP.Types
import qualified Data.ByteString as B
import Control.Monad (unless)

-- Echo server that reads entire body strictly
echoApp :: Application
echoApp request respond = do
    body <- strictRequestBody request
    respond $ responseLBS
        status200
        [("Content-Type", "application/octet-stream"),
         ("Content-Length", pack $ show $ L.length body)]
        body

-- Streaming request body processing
streamingApp :: Application
streamingApp request respond = do
    let loop = do
            chunk <- getRequestBodyChunk request
            unless (B.null chunk) $ do
                putStrLn $ "Received chunk: " ++ show (B.length chunk) ++ " bytes"
                loop
    loop
    respond $ responseLBS status200 [] "Body processed"
```
Tokens:
Raw