view release on metacpan or  search on metacpan

t/conformance/hap-tlv8.t  view on Meta::CPAN

#!/usr/bin/env perl
# ex:ts=8 sw=4:
# Conformance tests for spec/HAP-TLV8.md

use v5.36;
use Test::More;
use FindBin qw($RealBin);
use lib "$RealBin/../../lib";
use lib "$RealBin/../lib";
use Fugu::TestLog;

use_ok('Protocol::HAP::TLV');
use_ok('Protocol::HAP::Pairing');

subtest '[HAP-TLV8 §1] basic record structure' => sub {
	my $encoded = Protocol::HAP::TLV::encode( 0x06, "\x01" );
	is( length($encoded), 3, 'record is type + length + value' );
	is( unpack( 'H*', $encoded ), '060101',
		'type, length and value bytes in order' );

	my $empty = Protocol::HAP::TLV::encode( 0x0A, '' );
	is( unpack( 'H*', $empty ), '0a00', 'zero-length value encodes' );
};

subtest '[HAP-TLV8 §2] fragmentation of long values' => sub {
	my $value   = 'X' x 500;
	my $encoded = Protocol::HAP::TLV::encode( 0x03, $value );

	# 500 bytes -> 255 + 245: 2 records with 2-byte headers each
	is( length($encoded), 500 + 4, 'two records for 500 bytes' );

	# The first fragment must be exactly 255 bytes
	my ( $t1, $l1 ) = unpack( 'CC', substr( $encoded, 0, 2 ) );
	is( $t1, 0x03, 'first fragment has value type' );
	is( $l1, 255,  'non-final fragment is exactly 255 bytes' );

	my ( $t2, $l2 ) = unpack( 'CC', substr( $encoded, 257, 2 ) );
	is( $t2, 0x03, 'second fragment has same type' );
	is( $l2, 245,  'final fragment carries the remainder' );

	# The decoder concatenates same-type records
	my %decoded = Protocol::HAP::TLV::decode($encoded);
	is( $decoded{0x03}, $value, 'fragments concatenated on decode' );
};

subtest '[HAP-TLV8 §8][HAP-TLV8 §8.2] 384-byte SRP key splits FF/81' =>
    sub {
	my $key     = 'K' x 384;
	my $encoded = Protocol::HAP::TLV::encode( 0x03, $key );

	is( length($encoded), 384 + 4, '384 bytes need two records' );
	is( unpack( 'C', substr( $encoded, 1, 1 ) ),
		0xFF, 'first fragment length byte is FF (255)' );
	is( unpack( 'C', substr( $encoded, 257 + 1, 1 ) ),
		0x81, 'second fragment length byte is 81 (129)' );

	my %decoded = Protocol::HAP::TLV::decode($encoded);
	is( length( $decoded{0x03} ), 384, 'round-trips to 384 bytes' );
};

subtest '[HAP-TLV8 §3] separators between list items' => sub {
	my $encoded = Protocol::HAP::TLV::encode(
		Protocol::HAP::Pairing::kTLVType_Separator(), '' );
	is( unpack( 'H*', $encoded ), 'ff00',
		'separator is type 0xFF with zero length' );
};

subtest '[HAP-TLV8 §4] value encodings' => sub {

	# [HAP-TLV8 §4.1] integers are little-endian and use the minimum
	# bytes
	is( unpack( 'H*', Protocol::HAP::TLV::encode( 0x0B, pack( 'C', 1 ) ) ),
		'0b0101', '[HAP-TLV8 §4.1] integer 1 encodes as 01' );
	is( unpack( 'H*', Protocol::HAP::TLV::encode( 0x0B, pack( 'v', 256 ) ) ),
		'0b020001',
		'[HAP-TLV8 §4.1] integer 256 encodes as 00 01 (LE)' );
	is( unpack( 'H*', Protocol::HAP::TLV::encode( 0x0B, pack( 'V', 65536 ) ) ),
		'0b0400000100',
		'[HAP-TLV8 §4.1] integer 65536 encodes as 00 00 01 00 (LE)' );

	# [HAP-TLV8 §4.2] strings without null terminator
	is( unpack( 'H*', Protocol::HAP::TLV::encode( 0x01, 'Hello' ) ),
		'010548656c6c6f',
		'[HAP-TLV8 §4.2] UTF-8 bytes, no null terminator' );

	# [HAP-TLV8 §4.3] binary data round-trips raw
	my $binary  = pack( 'H*', '00ff10deadbeef' );
	my %decoded =
	    Protocol::HAP::TLV::decode( Protocol::HAP::TLV::encode( 0x05, $binary ) );
	is( unpack( 'H*', $decoded{0x05} ),
		'00ff10deadbeef',
		'[HAP-TLV8 §4.3] raw bytes preserved' );

	# [HAP-TLV8 §4.4] a TLV value can be a nested TLV structure
	my $inner = Protocol::HAP::TLV::encode( 0x01, 'id', 0x0A, 'sig' );
	my %outer =
	    Protocol::HAP::TLV::decode( Protocol::HAP::TLV::encode( 0x05, $inner ) );
	my %nested = Protocol::HAP::TLV::decode( $outer{0x05} );
	is( $nested{0x01}, 'id',
		'[HAP-TLV8 §4.4] nested TLV decodes from sub-TLV value' );
	is( $nested{0x0A}, 'sig', '[HAP-TLV8 §4.4] all nested fields kept' );
};

subtest '[HAP-TLV8 §5] pairing TLV type codes' => sub {
	my %types = (
		Method        => 0x00,
		Identifier    => 0x01,
		Salt          => 0x02,
		PublicKey     => 0x03,
		Proof         => 0x04,
		EncryptedData => 0x05,
		State         => 0x06,
		Error         => 0x07,
		RetryDelay    => 0x08,
		Certificate   => 0x09,