{$mode objfpc}{$H+}

/// <summary>
/// uCICMQTTProtocol — stateless MQTT packet building and parsing helpers.
/// Contains ALL packet builders and parsers as pure functions with no I/O,
/// no TCP dependency, and no mutable state.  Drop this unit into any project
/// that needs to construct or decode raw MQTT byte streams.
/// Supports MQTT 5.0 (protocol level 5) and MQTT 3.1.1 (protocol level 4).
/// </summary>
unit uCICMQTTProtocol;

interface

uses
  SysUtils, Classes;

// ---------------------------------------------------------------------------
// Protocol-level constants
// ---------------------------------------------------------------------------

const
  MQTT_PROTOCOL_LEVEL_50  = 5;
  MQTT_PROTOCOL_LEVEL_311 = 4;

  // Packet type nibbles (upper 4 bits of the fixed header, un-shifted)
  MQTT_CONNECT     = 1;
  MQTT_CONNACK     = 2;
  MQTT_PUBLISH     = 3;
  MQTT_PUBACK      = 4;
  MQTT_SUBSCRIBE   = 8;
  MQTT_SUBACK      = 9;
  MQTT_UNSUBSCRIBE = 10;
  MQTT_UNSUBACK    = 11;
  MQTT_PINGREQ     = 12;
  MQTT_PINGRESP    = 13;
  MQTT_DISCONNECT  = 14;
  MQTT_AUTH        = 15;

  // CONNECT property identifiers (MQTT 5.0 §3.1.2.11)
  PROP_SESSION_EXPIRY_INTERVAL = $11;

// ---------------------------------------------------------------------------
// Variable-length integer (VarInt) encoding / decoding
// ---------------------------------------------------------------------------

/// <summary>
/// Encodes a Cardinal value as an MQTT variable-length integer (1–4 bytes).
/// Values up to 268,435,455 (0xFFFFFFF) are supported per the MQTT spec.
/// </summary>
function EncodeVarInt(AValue: Cardinal): TBytes;

/// <summary>
/// Decodes an MQTT variable-length integer from AData starting at AOffset.
/// AOffset is advanced past the consumed bytes on success.
/// Returns False if the data is truncated or malformed (more than 4 bytes).
/// </summary>
function DecodeVarInt(const AData: TBytes; var AOffset: Integer;
  out AValue: Cardinal): Boolean;

// ---------------------------------------------------------------------------
// UTF-8 string encoding / decoding (2-byte big-endian length prefix)
// ---------------------------------------------------------------------------

/// <summary>
/// Encodes AStr as an MQTT UTF-8 string: a 2-byte big-endian length followed
/// by the UTF-8 bytes of AStr.
/// </summary>
function EncodeMQTTString(const AStr: String): TBytes;

/// <summary>
/// Decodes an MQTT UTF-8 string from AData starting at AOffset.
/// AOffset is advanced past the consumed bytes on success.
/// Returns False if the data is truncated.
/// </summary>
function DecodeMQTTString(const AData: TBytes; var AOffset: Integer;
  out AStr: String): Boolean;

// ---------------------------------------------------------------------------
// 2-byte big-endian Word encoding / decoding
// ---------------------------------------------------------------------------

/// <summary>
/// Encodes AValue as a 2-byte big-endian Word (network byte order).
/// </summary>
function EncodeWord(AValue: Word): TBytes;

/// <summary>
/// Decodes a 2-byte big-endian Word from AData starting at AOffset.
/// AOffset is advanced by 2 on success.
/// Returns False if fewer than 2 bytes remain.
/// </summary>
function DecodeWord(const AData: TBytes; var AOffset: Integer;
  out AValue: Word): Boolean;

// ---------------------------------------------------------------------------
// Fixed-header wrapper
// ---------------------------------------------------------------------------

/// <summary>
/// Prepends the MQTT fixed header (type + flags byte, then remaining-length
/// encoded as a VarInt) to AContent and returns the complete packet bytes.
/// APacketType is the upper-nibble value (e.g. MQTT_CONNECT = 1).
/// AFlags occupies the lower 4 bits of the first byte.
/// </summary>
function WrapWithFixedHeader(APacketType: Byte; AFlags: Byte;
  const AContent: TBytes): TBytes;

// ---------------------------------------------------------------------------
// Packet builders
// ---------------------------------------------------------------------------

/// <summary>
/// Builds a complete MQTT CONNECT packet.
/// AProtocolLevel selects MQTT 5.0 (MQTT_PROTOCOL_LEVEL_50) or
/// MQTT 3.1.1 (MQTT_PROTOCOL_LEVEL_311).
/// ACleanStart sets the Clean Start / Clean Session flag.
/// AKeepAliveSecs is the keepalive interval in seconds (0 = disabled).
/// ASessionExpiryInterval is the MQTT 5.0 Session Expiry Interval property
/// in seconds (0 = session ends at disconnect); ignored for MQTT 3.1.1.
/// Username and Password are optional; omitting them clears the respective flags.
/// </summary>
function BuildConnectPacket(AProtocolLevel: Byte; ACleanStart: Boolean;
  AKeepAliveSecs: Word; const AClientID: String;
  const AUsername: String = ''; const APassword: String = '';
  ASessionExpiryInterval: UInt32 = 0): TBytes;

/// <summary>
/// Builds a complete MQTT PUBLISH packet.
/// AQoS must be 0, 1, or 2.  APacketId is ignored when AQoS = 0.
/// AProtocolLevel controls whether an MQTT 5.0 zero-length properties
/// section is appended to the variable header.
/// ARetain sets the RETAIN flag; ADup sets the DUP flag.
/// APayload is sent as raw bytes (no encoding applied by this function).
/// </summary>
function BuildPublishPacket(const ATopic: String; const APayload: TBytes;
  AQoS: Byte; APacketId: Word; AProtocolLevel: Byte;
  ARetain: Boolean = False; ADup: Boolean = False): TBytes;

/// <summary>
/// Builds a complete MQTT PUBACK packet.
/// For MQTT 5.0 the packet includes the reason code byte and a
/// zero-length properties section.
/// For MQTT 3.1.1 the reason code is omitted.
/// </summary>
function BuildPubAckPacket(APacketId: Word; AReasonCode: Byte;
  AProtocolLevel: Byte): TBytes;

/// <summary>
/// Builds a complete MQTT SUBSCRIBE packet for a single topic filter.
/// Fixed-header flags are always $02 as required by the MQTT spec.
/// AQoS is placed in bits 0-1 of the subscription options byte.
/// For MQTT 5.0 a zero-length properties section is included.
/// </summary>
function BuildSubscribePacket(const ATopic: String; AQoS: Byte;
  APacketId: Word; AProtocolLevel: Byte): TBytes;

/// <summary>
/// Builds a complete MQTT UNSUBSCRIBE packet for a single topic filter.
/// Fixed-header flags are always $02 as required by the MQTT spec.
/// For MQTT 5.0 a zero-length properties section is included.
/// </summary>
function BuildUnsubscribePacket(const ATopic: String;
  APacketId: Word; AProtocolLevel: Byte): TBytes;

/// <summary>
/// Builds a complete MQTT PINGREQ packet (always [$C0, $00]).
/// </summary>
function BuildPingReqPacket: TBytes;

/// <summary>
/// Builds a complete MQTT DISCONNECT packet.
/// For MQTT 5.0 the reason code and a zero-length properties section are
/// included in the variable header.
/// For MQTT 3.1.1 the remaining length is 0 and the reason code is omitted.
/// </summary>
function BuildDisconnectPacket(AReasonCode: Byte;
  AProtocolLevel: Byte): TBytes;

// ---------------------------------------------------------------------------
// Packet parsers
// ---------------------------------------------------------------------------

/// <summary>
/// Parses an MQTT CONNACK variable header from AData starting at AOffset.
/// AOffset must point to the first byte AFTER the fixed header byte and
/// AFTER the remaining-length field (i.e. to the start of the variable header).
/// Sets ASessionPresent and AReasonCode from the packet contents.
/// For MQTT 5.0 the properties section is skipped transparently.
/// Returns False if AData is too short to contain a valid CONNACK body.
/// </summary>
function ParseConnAck(const AData: TBytes; var AOffset: Integer;
  out ASessionPresent: Boolean; out AReasonCode: Byte): Boolean;

implementation

// ---------------------------------------------------------------------------
// Internal helper — concatenate two TBytes arrays
// ---------------------------------------------------------------------------

function ConcatBytes(const A, B: TBytes): TBytes;
var
  LA, LB: Integer;
begin
  LA := Length(A);
  LB := Length(B);
  SetLength(Result, LA + LB);
  if LA > 0 then Move(A[0], Result[0],  LA);
  if LB > 0 then Move(B[0], Result[LA], LB);
end;

// Internal helper — append a single byte to a TBytes array
function AppendByte(const A: TBytes; B: Byte): TBytes;
var
  LA: Integer;
begin
  LA := Length(A);
  SetLength(Result, LA + 1);
  if LA > 0 then Move(A[0], Result[0], LA);
  Result[LA] := B;
end;

// ---------------------------------------------------------------------------
// VarInt
// ---------------------------------------------------------------------------

function EncodeVarInt(AValue: Cardinal): TBytes;
var
  Buf:         array[0..3] of Byte;
  Len:         Integer;
  EncodedByte: Byte;
begin
  Len := 0;
  repeat
    EncodedByte := AValue mod 128;
    AValue      := AValue div 128;
    if AValue > 0 then
      EncodedByte := EncodedByte or $80;
    Buf[Len] := EncodedByte;
    Inc(Len);
  until AValue = 0;
  SetLength(Result, Len);
  Move(Buf[0], Result[0], Len);
end;

function DecodeVarInt(const AData: TBytes; var AOffset: Integer;
  out AValue: Cardinal): Boolean;
var
  Multiplier: Cardinal;
  B:          Byte;
  Iterations: Integer;
begin
  Result     := False;
  AValue     := 0;
  Multiplier := 1;
  Iterations := 0;
  repeat
    if AOffset >= Length(AData) then Exit; // truncated
    B       := AData[AOffset];
    Inc(AOffset);
    Inc(Iterations);
    AValue := AValue + (B and $7F) * Multiplier;
    Multiplier := Multiplier * 128;
    if Iterations > 4 then Exit; // malformed — more than 4 bytes
  until (B and $80) = 0;
  Result := True;
end;

// ---------------------------------------------------------------------------
// MQTT UTF-8 strings
// ---------------------------------------------------------------------------

function EncodeMQTTString(const AStr: String): TBytes;
var
  UTF8Bytes: TBytes;
  SLen:      Word;
begin
  UTF8Bytes := TEncoding.UTF8.GetBytes(AStr);
  SLen      := Length(UTF8Bytes);
  SetLength(Result, 2 + SLen);
  Result[0] := (SLen shr 8) and $FF;
  Result[1] :=  SLen        and $FF;
  if SLen > 0 then
    Move(UTF8Bytes[0], Result[2], SLen);
end;

function DecodeMQTTString(const AData: TBytes; var AOffset: Integer;
  out AStr: String): Boolean;
var
  SLen: Word;
begin
  Result := False;
  AStr   := '';
  // Need at least 2 bytes for the length prefix
  if AOffset + 2 > Length(AData) then Exit;
  SLen    := (Word(AData[AOffset]) shl 8) or AData[AOffset + 1];
  Inc(AOffset, 2);
  // Need SLen more bytes
  if AOffset + Integer(SLen) > Length(AData) then Exit;
  if SLen > 0 then
  begin
    AStr := TEncoding.UTF8.GetString(AData, AOffset, SLen);
    Inc(AOffset, SLen);
  end;
  Result := True;
end;

// ---------------------------------------------------------------------------
// 2-byte big-endian Word
// ---------------------------------------------------------------------------

function EncodeWord(AValue: Word): TBytes;
begin
  SetLength(Result, 2);
  Result[0] := (AValue shr 8) and $FF;
  Result[1] :=  AValue        and $FF;
end;

function DecodeWord(const AData: TBytes; var AOffset: Integer;
  out AValue: Word): Boolean;
begin
  Result := False;
  AValue := 0;
  if AOffset + 2 > Length(AData) then Exit;
  AValue  := (Word(AData[AOffset]) shl 8) or AData[AOffset + 1];
  Inc(AOffset, 2);
  Result  := True;
end;

// ---------------------------------------------------------------------------
// Fixed-header wrapper
// ---------------------------------------------------------------------------

function WrapWithFixedHeader(APacketType: Byte; AFlags: Byte;
  const AContent: TBytes): TBytes;
var
  FirstByte: Byte;
  RemLen:    TBytes;
begin
  FirstByte := ((APacketType and $0F) shl 4) or (AFlags and $0F);
  RemLen    := EncodeVarInt(Length(AContent));
  SetLength(Result, 1 + Length(RemLen) + Length(AContent));
  Result[0] := FirstByte;
  if Length(RemLen) > 0 then
    Move(RemLen[0], Result[1], Length(RemLen));
  if Length(AContent) > 0 then
    Move(AContent[0], Result[1 + Length(RemLen)], Length(AContent));
end;

// ---------------------------------------------------------------------------
// CONNECT
// ---------------------------------------------------------------------------

function BuildConnectPacket(AProtocolLevel: Byte; ACleanStart: Boolean;
  AKeepAliveSecs: Word; const AClientID: String;
  const AUsername: String = ''; const APassword: String = '';
  ASessionExpiryInterval: UInt32 = 0): TBytes;
var
  VarHeader: TBytes;
  Payload:   TBytes;
  Props:     TBytes;
  SessExp:   TBytes;
  PropLen:   TBytes;
  ConnFlags: Byte;
  Content:   TBytes;
begin
  // --- Connect flags ---
  ConnFlags := 0;
  if ACleanStart  then ConnFlags := ConnFlags or $02;
  if AUsername <> '' then ConnFlags := ConnFlags or $80;
  if APassword <> '' then ConnFlags := ConnFlags or $40;

  // --- Properties (MQTT 5.0 only) ---
  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    Props := nil;
    if ASessionExpiryInterval > 0 then
    begin
      SetLength(SessExp, 5);
      SessExp[0] :=  PROP_SESSION_EXPIRY_INTERVAL;
      SessExp[1] := (ASessionExpiryInterval shr 24) and $FF;
      SessExp[2] := (ASessionExpiryInterval shr 16) and $FF;
      SessExp[3] := (ASessionExpiryInterval shr  8) and $FF;
      SessExp[4] :=  ASessionExpiryInterval         and $FF;
      Props      := SessExp;
    end;
    PropLen := EncodeVarInt(Length(Props));
    Props   := ConcatBytes(PropLen, Props);
  end
  else
  begin
    // MQTT 3.1.1: no properties section
    SetLength(Props, 0);
  end;

  // --- Variable header ---
  // Protocol name "MQTT" (length-prefixed UTF-8)
  VarHeader := EncodeMQTTString('MQTT');
  // Protocol level byte
  VarHeader := AppendByte(VarHeader, AProtocolLevel);
  // Connect flags
  VarHeader := AppendByte(VarHeader, ConnFlags);
  // Keep-alive (2 bytes, big-endian)
  VarHeader := AppendByte(VarHeader, (AKeepAliveSecs shr 8) and $FF);
  VarHeader := AppendByte(VarHeader,  AKeepAliveSecs         and $FF);
  // Properties
  VarHeader := ConcatBytes(VarHeader, Props);

  // --- Payload ---
  Payload := EncodeMQTTString(AClientID);
  if AUsername <> '' then
    Payload := ConcatBytes(Payload, EncodeMQTTString(AUsername));
  if APassword <> '' then
    Payload := ConcatBytes(Payload, EncodeMQTTString(APassword));

  Content := ConcatBytes(VarHeader, Payload);
  Result  := WrapWithFixedHeader(MQTT_CONNECT, 0, Content);
end;

// ---------------------------------------------------------------------------
// PUBLISH
// ---------------------------------------------------------------------------

function BuildPublishPacket(const ATopic: String; const APayload: TBytes;
  AQoS: Byte; APacketId: Word; AProtocolLevel: Byte;
  ARetain: Boolean = False; ADup: Boolean = False): TBytes;
var
  VarHeader: TBytes;
  PropLen:   TBytes;
  Content:   TBytes;
  Flags:     Byte;
begin
  // Fixed-header flags: DUP(3) | QoS(2-1) | RETAIN(0)
  Flags := 0;
  if ARetain              then Flags := Flags or $01;
  Flags := Flags or ((AQoS and $03) shl 1);
  if ADup                 then Flags := Flags or $08;

  // Variable header: topic
  VarHeader := EncodeMQTTString(ATopic);

  // Packet identifier (QoS 1 and 2 only)
  if AQoS > 0 then
  begin
    VarHeader := AppendByte(VarHeader, (APacketId shr 8) and $FF);
    VarHeader := AppendByte(VarHeader,  APacketId         and $FF);
  end;

  // Properties length = 0 (MQTT 5.0 only)
  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    PropLen   := EncodeVarInt(0);
    VarHeader := ConcatBytes(VarHeader, PropLen);
  end;

  // Payload
  Content := ConcatBytes(VarHeader, APayload);
  Result  := WrapWithFixedHeader(MQTT_PUBLISH, Flags, Content);
end;

// ---------------------------------------------------------------------------
// PUBACK
// ---------------------------------------------------------------------------

function BuildPubAckPacket(APacketId: Word; AReasonCode: Byte;
  AProtocolLevel: Byte): TBytes;
var
  Content: TBytes;
begin
  // Variable header always starts with the 2-byte packet identifier
  Content := EncodeWord(APacketId);

  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    // MQTT 5.0: reason code + zero-length properties
    Content := AppendByte(Content, AReasonCode);
    Content := AppendByte(Content, 0); // properties length = 0
  end;
  // MQTT 3.1.1: no reason code, no properties

  Result := WrapWithFixedHeader(MQTT_PUBACK, 0, Content);
end;

// ---------------------------------------------------------------------------
// SUBSCRIBE
// ---------------------------------------------------------------------------

function BuildSubscribePacket(const ATopic: String; AQoS: Byte;
  APacketId: Word; AProtocolLevel: Byte): TBytes;
var
  VarHeader: TBytes;
  TopicData: TBytes;
  PropLen:   TBytes;
  Content:   TBytes;
begin
  // Packet identifier
  VarHeader := EncodeWord(APacketId);

  // Properties length = 0 (MQTT 5.0 only)
  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    PropLen   := EncodeVarInt(0);
    VarHeader := ConcatBytes(VarHeader, PropLen);
  end;

  // Topic filter + subscription options (QoS in bits 0-1)
  TopicData := EncodeMQTTString(ATopic);
  TopicData := AppendByte(TopicData, AQoS and $03);

  Content := ConcatBytes(VarHeader, TopicData);
  // Fixed-header flags must be $02 per MQTT spec §3.8.1
  Result  := WrapWithFixedHeader(MQTT_SUBSCRIBE, $02, Content);
end;

// ---------------------------------------------------------------------------
// UNSUBSCRIBE
// ---------------------------------------------------------------------------

function BuildUnsubscribePacket(const ATopic: String;
  APacketId: Word; AProtocolLevel: Byte): TBytes;
var
  VarHeader: TBytes;
  TopicData: TBytes;
  PropLen:   TBytes;
  Content:   TBytes;
begin
  // Packet identifier
  VarHeader := EncodeWord(APacketId);

  // Properties length = 0 (MQTT 5.0 only)
  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    PropLen   := EncodeVarInt(0);
    VarHeader := ConcatBytes(VarHeader, PropLen);
  end;

  // Topic filter (no options byte for UNSUBSCRIBE)
  TopicData := EncodeMQTTString(ATopic);

  Content := ConcatBytes(VarHeader, TopicData);
  // Fixed-header flags must be $02 per MQTT spec §3.10.1
  Result  := WrapWithFixedHeader(MQTT_UNSUBSCRIBE, $02, Content);
end;

// ---------------------------------------------------------------------------
// PINGREQ
// ---------------------------------------------------------------------------

function BuildPingReqPacket: TBytes;
begin
  SetLength(Result, 2);
  Result[0] := $C0; // MQTT_PINGREQ (12) shl 4
  Result[1] := $00; // remaining length = 0
end;

// ---------------------------------------------------------------------------
// DISCONNECT
// ---------------------------------------------------------------------------

function BuildDisconnectPacket(AReasonCode: Byte;
  AProtocolLevel: Byte): TBytes;
var
  Content: TBytes;
begin
  if AProtocolLevel = MQTT_PROTOCOL_LEVEL_50 then
  begin
    // MQTT 5.0: reason code + zero-length properties section
    SetLength(Content, 2);
    Content[0] := AReasonCode;
    Content[1] := 0; // properties length = 0
  end
  else
  begin
    // MQTT 3.1.1: remaining length is 0, no variable header
    SetLength(Content, 0);
  end;
  Result := WrapWithFixedHeader(MQTT_DISCONNECT, 0, Content);
end;

// ---------------------------------------------------------------------------
// CONNACK parser
// ---------------------------------------------------------------------------

function ParseConnAck(const AData: TBytes; var AOffset: Integer;
  out ASessionPresent: Boolean; out AReasonCode: Byte): Boolean;
var
  PropLen: Cardinal;
begin
  Result         := False;
  ASessionPresent := False;
  AReasonCode    := $FF; // indicate "not parsed" until we succeed

  // Need at least the 2 fixed bytes of the CONNACK variable header
  // (Session Present flags byte + Reason/Return Code byte)
  if AOffset + 2 > Length(AData) then Exit;

  ASessionPresent := (AData[AOffset] and $01) <> 0;
  Inc(AOffset);

  AReasonCode := AData[AOffset];
  Inc(AOffset);

  // Skip MQTT 5.0 properties if present — any remaining bytes belong to them
  if AOffset < Length(AData) then
  begin
    // Attempt to decode properties length; ignore errors (optional section)
    DecodeVarInt(AData, AOffset, PropLen);
    // Advance past the properties payload
    if AOffset + Integer(PropLen) <= Length(AData) then
      Inc(AOffset, PropLen)
    else
      AOffset := Length(AData); // clamp; caller can check if needed
  end;

  Result := True;
end;

end.