stdlib: add Net.WebSockets (RFC 6455 framing + handshake)

Transport-agnostic WebSocket helpers: WebSocketAccept (handshake key),
EncodeFrame/EncodeTextFrame (server->client, unmasked, up to 2^31-1), and
DecodeFrame (parses one frame, unmasking masked client frames). Pairs with
Net.Sockets. Tests cover the RFC 6455 accept vector, encode length forms,
and masked/unmasked round-trips (38 tests total).

stdlib/src/main/pascal/net.websockets.pas

@@ -0,0 +1,181 @@
+{
+  Blaise - An Object Pascal Compiler
+  Copyright (c) 2026 Graeme Geldenhuys
+  SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
+  Licensed under the Apache License v2.0 with Runtime Library Exception.
+  See LICENSE file in the project root for full license terms.
+}
+
+{ Blaise stdlib - WebSocket (RFC 6455) framing and handshake helpers.
+
+  This unit is transport-agnostic: it turns bytes into frames and back, and
+  computes the handshake accept key.  It does NOT own a socket — pair it with
+  Net.Sockets (or any byte stream) to drive a connection.
+
+    * WebSocketAccept   — the Sec-WebSocket-Accept value for a client key.
+    * EncodeTextFrame   — build a server->client text frame (RFC 6455 5.2),
+                          unmasked, payloads up to 2^31-1.
+    * DecodeFrame       — parse one frame from a buffer, unmasking the payload
+                          (client->server frames are always masked).
+
+  Server frames are sent unmasked; client frames must be masked.  DecodeFrame
+  handles both.  Continuation/fragmentation is reported via the FIN flag but
+  not reassembled here (callers needing message reassembly concatenate the
+  payloads of a FIN=False frame followed by opcode-0 continuation frames). }
+
+unit Net.WebSockets;
+
+interface
+
+const
+  { RFC 6455 opcodes }
+  WS_OP_CONTINUATION = $0;
+  WS_OP_TEXT         = $1;
+  WS_OP_BINARY       = $2;
+  WS_OP_CLOSE        = $8;
+  WS_OP_PING         = $9;
+  WS_OP_PONG         = $A;
+
+type
+  { One decoded frame.  Payload holds the unmasked bytes (as a string). }
+  TWsFrame = record
+    Valid:   Boolean;   { False if the buffer held no complete frame }
+    Fin:     Boolean;   { final fragment of a message }
+    Opcode:  Integer;
+    Payload: string;
+    { Number of bytes consumed from the input buffer for this frame; callers
+      streaming a socket advance their buffer by this much. }
+    Consumed: Integer;
+  end;
+
+{ Compute Sec-WebSocket-Accept for a client's Sec-WebSocket-Key (the value
+  echoed back in the 101 handshake response). }
+function WebSocketAccept(const AKey: string): string;
+
+{ Build an unmasked text frame carrying APayload (server->client). }
+function EncodeTextFrame(const APayload: string): string;
+
+{ Build an unmasked frame with an explicit opcode (e.g. WS_OP_BINARY,
+  WS_OP_PING, WS_OP_CLOSE).  Server frames are never masked. }
+function EncodeFrame(AOpcode: Integer; const APayload: string): string;
+
+{ Parse the first frame in ABuffer.  Returns Valid=False (Consumed=0) if the
+  buffer does not yet hold a complete frame — read more bytes and retry. }
+function DecodeFrame(const ABuffer: string): TWsFrame;
+
+implementation
+
+uses
+  Security.Crypto, Encoding.Base64, StrUtils;
+
+const
+  { the RFC 6455 magic GUID appended to the key before hashing }
+  WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
+
+function WebSocketAccept(const AKey: string): string;
+begin
+  Result := Base64Encode(Sha1(AKey + WS_GUID));
+end;
+
+function EncodeFrame(AOpcode: Integer; const APayload: string): string;
+var
+  SB: TStringBuilder;
+  Len: Integer;
+begin
+  SB := TStringBuilder.Create();
+  SB.AppendByte($80 or (AOpcode and $0F));   { FIN + opcode, unmasked }
+  Len := Length(APayload);
+  if Len < 126 then
+    SB.AppendByte(Len)
+  else if Len <= 65535 then
+  begin
+    SB.AppendByte(126);
+    SB.AppendByte((Len shr 8) and $FF);
+    SB.AppendByte(Len and $FF);
+  end
+  else
+  begin
+    { 64-bit length; top 4 bytes are 0 since strings here fit in 2^31-1. }
+    SB.AppendByte(127);
+    SB.AppendByte(0); SB.AppendByte(0); SB.AppendByte(0); SB.AppendByte(0);
+    SB.AppendByte((Len shr 24) and $FF);
+    SB.AppendByte((Len shr 16) and $FF);
+    SB.AppendByte((Len shr 8) and $FF);
+    SB.AppendByte(Len and $FF);
+  end;
+  SB.Append(APayload);
+  Result := SB.ToString();
+  SB.Free();
+end;
+
+function EncodeTextFrame(const APayload: string): string;
+begin
+  Result := EncodeFrame(WS_OP_TEXT, APayload);
+end;
+
+function DecodeFrame(const ABuffer: string): TWsFrame;
+var
+  N, Pos, I: Integer;
+  B0, B1: Byte;
+  Masked: Boolean;
+  PayLen: Int64;
+  Mask: array[0..3] of Byte;
+  SB: TStringBuilder;
+begin
+  Result.Valid := False;
+  Result.Consumed := 0;
+  Result.Payload := '';
+
+  N := Length(ABuffer);
+  if N < 2 then Exit;   { need at least the 2-byte header }
+
+  B0 := Byte(ABuffer[0]);
+  B1 := Byte(ABuffer[1]);
+  Result.Fin    := (B0 and $80) <> 0;
+  Result.Opcode := B0 and $0F;
+  Masked := (B1 and $80) <> 0;
+  PayLen := B1 and $7F;
+  Pos := 2;
+
+  if PayLen = 126 then
+  begin
+    if N < Pos + 2 then Exit;
+    PayLen := (Int64(Byte(ABuffer[Pos])) shl 8) or Int64(Byte(ABuffer[Pos + 1]));
+    Pos := Pos + 2;
+  end
+  else if PayLen = 127 then
+  begin
+    if N < Pos + 8 then Exit;
+    { 64-bit length; we only support the low 31 bits (string length). }
+    PayLen := 0;
+    for I := 0 to 7 do
+      PayLen := (PayLen shl 8) or Int64(Byte(ABuffer[Pos + I]));
+    Pos := Pos + 8;
+  end;
+
+  if Masked then
+  begin
+    if N < Pos + 4 then Exit;
+    for I := 0 to 3 do
+      Mask[I] := Byte(ABuffer[Pos + I]);
+    Pos := Pos + 4;
+  end;
+
+  if N < Pos + PayLen then Exit;   { payload not fully arrived }
+
+  SB := TStringBuilder.Create();
+  for I := 0 to Integer(PayLen) - 1 do
+  begin
+    if Masked then
+      SB.AppendByte(Byte(ABuffer[Pos + I]) xor Mask[I and 3])
+    else
+      SB.AppendByte(Byte(ABuffer[Pos + I]));
+  end;
+  Result.Payload := SB.ToString();
+  SB.Free();
+
+  Result.Consumed := Pos + Integer(PayLen);
+  Result.Valid := True;
+end;
+
+end.

stdlib/src/test/pascal/test.registry.pas

@@ -24,7 +24,8 @@ uses
   Json.Tests,
   Base64.Tests,
   Crypto.Tests,
-  Sockets.Tests;
+  Sockets.Tests,
+  WebSockets.Tests;
 
 implementation
 

stdlib/src/test/pascal/websockets.tests.pas

@@ -0,0 +1,120 @@
+{
+  Blaise - An Object Pascal Compiler
+  Copyright (c) 2026 Graeme Geldenhuys
+  SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
+  Licensed under the Apache License v2.0 with Runtime Library Exception.
+  See LICENSE file in the project root for full license terms.
+}
+
+{ Tests for Net.WebSockets: handshake accept key and frame encode/decode.
+  Self-registers via the initialization section. }
+
+unit WebSockets.Tests;
+
+interface
+
+uses
+  blaise.testing, Net.WebSockets;
+
+type
+  TWebSocketsTests = class(TTestCase)
+  published
+    procedure TestAccept;
+    procedure TestEncodeShortText;
+    procedure TestEncode126;
+    procedure TestRoundTripUnmasked;
+    procedure TestRoundTripMasked;
+    procedure TestPartialBufferIsInvalid;
+  end;
+
+implementation
+
+procedure TWebSocketsTests.TestAccept;
+begin
+  { RFC 6455 6.1 worked example. }
+  AssertEquals('accept', 's3pPLMBiTxaQ9kYGzzhZRbK+xOo=',
+    WebSocketAccept('dGhlIHNhbXBsZSBub25jZQ=='));
+end;
+
+procedure TWebSocketsTests.TestEncodeShortText;
+var F: string;
+begin
+  F := EncodeTextFrame('hi');
+  AssertEquals('len', 4, Integer(Length(F)));
+  AssertEquals('b0 fin+text', $81, Integer(Byte(F[0])));
+  AssertEquals('b1 len',      2,    Integer(Byte(F[1])));
+  AssertEquals('payload h',   104, Integer(Byte(F[2])));   { 'h' }
+end;
+
+procedure TWebSocketsTests.TestEncode126;
+var
+  Payload, F: string;
+  I: Integer;
+begin
+  { 200 bytes -> extended 16-bit length form (126 marker + 2 bytes). }
+  Payload := '';
+  for I := 1 to 200 do Payload := Payload + 'x';
+  F := EncodeTextFrame(Payload);
+  AssertEquals('b1 marker', 126, Integer(Byte(F[1])));
+  AssertEquals('len hi', 0,   Integer(Byte(F[2])));
+  AssertEquals('len lo', 200, Integer(Byte(F[3])));
+  AssertEquals('total', 4 + 200, Integer(Length(F)));
+end;
+
+procedure TWebSocketsTests.TestRoundTripUnmasked;
+var
+  F: string;
+  D: TWsFrame;
+begin
+  F := EncodeTextFrame('hello world');
+  D := DecodeFrame(F);
+  AssertTrue('valid', D.Valid);
+  AssertTrue('fin', D.Fin);
+  AssertEquals('opcode', WS_OP_TEXT, D.Opcode);
+  AssertEquals('payload', 'hello world', D.Payload);
+  AssertEquals('consumed', Length(F), D.Consumed);
+end;
+
+procedure TWebSocketsTests.TestRoundTripMasked;
+var
+  Buf: string;
+  D: TWsFrame;
+  SB: TStringBuilder;
+  Mask: array[0..3] of Byte;
+  Plain: string;
+  I: Integer;
+begin
+  { Hand-build a masked client text frame "ping" (clients must mask). }
+  Plain := 'ping';
+  Mask[0] := 10; Mask[1] := 20; Mask[2] := 30; Mask[3] := 40;
+  SB := TStringBuilder.Create();
+  SB.AppendByte($81);                 { FIN + text }
+  SB.AppendByte($80 or Length(Plain)); { MASK + len }
+  for I := 0 to 3 do SB.AppendByte(Mask[I]);
+  for I := 0 to Length(Plain) - 1 do
+    SB.AppendByte(Byte(Plain[I]) xor Mask[I and 3]);
+  Buf := SB.ToString();
+  SB.Free();
+
+  D := DecodeFrame(Buf);
+  AssertTrue('valid', D.Valid);
+  AssertEquals('unmasked payload', Plain, D.Payload);
+  AssertEquals('consumed', Length(Buf), D.Consumed);
+end;
+
+procedure TWebSocketsTests.TestPartialBufferIsInvalid;
+var
+  F, Partial: string;
+  D: TWsFrame;
+begin
+  F := EncodeTextFrame('hello world');
+  Partial := Copy(F, 0, 3);   { header + 1 payload byte, incomplete }
+  D := DecodeFrame(Partial);
+  AssertFalse('not valid', D.Valid);
+  AssertEquals('consumed 0', 0, D.Consumed);
+end;
+
+initialization
+  RegisterTest(TWebSocketsTests);
+
+end.