WebSockets

Implement real-time bidirectional communication with WebSocket support in Suave.

Basic WebSocket Handler

Create a simple WebSocket echo server:

open Suave
open Suave.WebSocket
open Suave.Sockets
open Suave.Sockets.Control
open System.Text
open Suave.Filters
open Suave.Operators

let echo (webSocket: WebSocket) (context: HttpContext) =
  socket {
    let mutable loop = true

    while loop do
      let! msg = webSocket.read()

      match msg with
      | (Text, data, true) ->
          let str = Encoding.UTF8.GetString data.Span
          let response = sprintf "Echo: %s" str
          let byteResponse =
            response
            |> Encoding.ASCII.GetBytes
            |> ByteSegment
          do! webSocket.send Text byteResponse true

      | (Close, _, _) ->
          do! webSocket.send Close (ByteSegment [||]) true
          loop <- false

      | _ -> ()
  }

let app =
  choose [
    path "/ws" >=> handShake echo
  ]

Broadcasting Messages

Broadcast messages to multiple WebSocket clients:

open Suave
open Suave.WebSocket
open System.Collections.Concurrent
open System.Text
open Suave.Filters
open Suave.Operators
open Suave.Sockets
open Suave.Sockets.Control

let clients = new ConcurrentDictionary<string, WebSocket>()

let broadcast (message: string) =
  let bytes = Encoding.UTF8.GetBytes(message) |> ByteSegment
  for client in clients.Values do
    client.send Text bytes true |> ignore

let chatHandler (webSocket: WebSocket) (context: HttpContext) =
  socket {
    let clientId = System.Guid.NewGuid().ToString()
    clients.TryAdd(clientId, webSocket) |> ignore
    
    let mutable loop = true
    while loop do
      let! msg = webSocket.read()

      match msg with
      | (Text, data, true) ->
          let str = Encoding.UTF8.GetString data.Span
          broadcast (sprintf "%s: %s" clientId str)

      | (Close, _, _) ->
          broadcast (sprintf "%s left" clientId)
          clients.TryRemove(clientId) |> ignore
          do! webSocket.send Close (ByteSegment [||]) true
          loop <- false

      | _ -> ()
  }

let app =
  choose [
    path "/chat" >=> handShake chatHandler
  ]

WebSocket with JSON Messages

Exchange structured JSON messages:

open Suave
open Suave.WebSocket
open System.Text
open System.Text.Json
open Suave.Filters
open Suave.Operators
open Suave.Sockets
open Suave.Sockets.Control

type Message = { user: string; text: string; timestamp: System.DateTime }

let jsonWebSocket (webSocket: WebSocket) (context: HttpContext) =
  socket {
    let mutable loop = true

    while loop do
      let! msg = webSocket.read()

      match msg with
      | (Text, data, true) ->
          try
            let json = Encoding.UTF8.GetString data.Span
            let message = JsonSerializer.Deserialize<Message>(json)
            
            let response = { message with timestamp = System.DateTime.UtcNow }
            let responseJson = JsonSerializer.Serialize(response)
            let responseBytes = Encoding.UTF8.GetBytes(responseJson) |> ByteSegment
            
            do! webSocket.send Text responseBytes true
          with _ -> ()

      | (Close, _, _) ->
          do! webSocket.send Close (ByteSegment [||]) true
          loop <- false

      | _ -> ()
  }

let app =
  choose [
    path "/json-ws" >=> handShake jsonWebSocket
  ]

Binary Data Transfer

Send and receive binary data over WebSocket:

open Suave
open Suave.WebSocket
open Suave.Filters
open Suave.Operators
open Suave.Sockets
open Suave.Sockets.Control

let binaryEcho (webSocket: WebSocket) (context: HttpContext) =
  socket {
    let mutable loop = true

    while loop do
      let! msg = webSocket.read()

      match msg with
      | (Binary, data, true) ->
          // Echo binary data back
          do! webSocket.send Binary data true

      | (Close, _, _) ->
          do! webSocket.send Close (ByteSegment [||]) true
          loop <- false

      | _ -> ()
  }

let app =
  choose [
    path "/binary" >=> handShake binaryEcho
  ]

Client-Side WebSocket Example

HTML/JavaScript client for WebSocket communication:

<!DOCTYPE html>
<html>
<body>
  <h1>WebSocket Chat</h1>
  <input type="text" id="message" placeholder="Type a message">
  <button onclick="sendMessage()">Send</button>
  <div id="messages"></div>

  <script>
    const ws = new WebSocket('ws://localhost:8080/chat');

    ws.onopen = () => {
      console.log('Connected');
    };

    ws.onmessage = (event) => {
      const div = document.createElement('div');
      div.textContent = event.data;
      document.getElementById('messages').appendChild(div);
    };

    ws.onerror = (error) => {
      console.error('WebSocket error:', error);
    };

    ws.onclose = () => {
      console.log('Disconnected');
    };

    function sendMessage() {
      const input = document.getElementById('message');
      ws.send(input.value);
      input.value = '';
    }
  </script>
</body>
</html>

Error Handling

Handle WebSocket errors gracefully:

open Suave
open Suave.WebSocket
open Suave.Filters
open Suave.Operators
open Suave.Sockets
open Suave.Sockets.Control

let safeWebSocket (webSocket: WebSocket) (context: HttpContext) =
  socket {
    try
      let mutable loop = true

      while loop do
        try
          let! msg = webSocket.read()

          match msg with
          | (Text, data, true) ->
              let str = System.Text.Encoding.UTF8.GetString data.Span
              let response = sprintf "OK: %s" str |> System.Text.Encoding.ASCII.GetBytes |> ByteSegment
              do! webSocket.send Text response true

          | (Close, _, _) ->
              do! webSocket.send Close (ByteSegment [||]) true
              loop <- false

          | _ -> ()
        with
        | ex ->
            printfn "WebSocket error: %s" ex.Message
            loop <- false

    with ex ->
      printfn "Fatal WebSocket error: %s" ex.Message
  }

let app =
  choose [
    path "/safe-ws" >=> handShake safeWebSocket
  ]

Real-Time Notifications

Push real-time notifications to connected clients:

open Suave
open Suave.WebSocket
open System.Collections.Concurrent
open System.Text
open Suave.Filters
open Suave.Operators
open Suave.Successful
open Suave.RequestErrors
open Suave.Sockets
open Suave.Sockets.Control

let notificationClients = new ConcurrentBag<WebSocket>()

let notificationHandler (webSocket: WebSocket) (context: HttpContext) =
  socket {
    notificationClients.Add(webSocket)
    
    let mutable loop = true
    while loop do
      let! msg = webSocket.read()

      match msg with
      | (Close, _, _) ->
          do! webSocket.send Close (ByteSegment [||]) true
          loop <- false

      | _ -> ()
  }

let sendNotification (notification: string) =
  let bytes = Encoding.UTF8.GetBytes(notification) |> ByteSegment
  for client in notificationClients do
    try
      client.send Text bytes true |> ignore
    with _ -> ()

let app =
  choose [
    path "/notifications" >=> handShake notificationHandler
    POST >=> path "/notify" >=> fun ctx ->
      match ctx.request.formData "message" with
      | Choice1Of2 msg ->
          sendNotification msg
          OK "Notification sent" ctx
      | _ -> RequestErrors.BAD_REQUEST "Missing message" ctx
  ]