view release on metacpan or  search on metacpan

lib/Protocol/HAP/Server.pm  view on Meta::CPAN

use v5.36;

package Protocol::HAP::Server;
our $VERSION = '0.1.0';

use JSON::PP;
use MIME::Base64 qw(encode_base64);
use Digest::SHA  qw(sha512);

use Protocol::HAP;
use Protocol::HAP::HTTP;
use Protocol::HAP::TLV;
use Protocol::HAP::Session;
use Protocol::HAP::Pairing;
use Protocol::HAP::Crypto;
use Protocol::HAP::Bridge;
use Protocol::HAP::Characteristic;
use Protocol::HAP::SetupCode qw(normalize_setup_code);

# Protocol::HAP::Server - the sans-IO HAP accessory-server engine.
#
# The engine consumes bytes and emits bytes. The host owns sockets,
# timers, logging, and persistence, injected through the contracts
# that Protocol/HAP.pod documents. The engine owns everything that is
# protocol: the read buffer and its bound, decryption, HTTP parsing,
# endpoint dispatch, the pairing state machines, the accessory
# database, and event delivery.

# The largest request the engine accepts: the header block plus the
# body that Content-Length declares. An unpaired client reaches
# /pair-setup, so the buffer of an unauthenticated connection needs a
# bound of its own. A HAP request is a small TLV or a short JSON
# document, so 64 KB is far above anything a controller sends.
use constant MAX_REQUEST_SIZE => 65536;

# The HAP status code for a request that arrives on an unverified
# connection [HAP-HTTP]. It is not an RFC 9110 code, so the codec does
# not know its reason phrase.
use constant STATUS_INSUFFICIENT_PRIVILEGES => 470;

# Characteristic types exempt from coalescing (HAP-HTTP.md §14):
# ProgrammableSwitchEvent (0x73), ButtonEvent (0x126),
# MotionDetected (0x22), ContactSensorState (0x6A)
use constant IMMEDIATE_EVENT_TYPES => {
	'73'  => 1,
	'126' => 1,
	'22'  => 1,
	'6A'  => 1,
};

# Event coalescing delay in seconds (HAP-HTTP.md §14)
use constant EVENT_COALESCE_DELAY => 0.250;

# _response(%args):
#	Build a response with the HAP defaults: the connection stays
#	open, because a controller sends every request of a session
#	over one connection.
sub _response (%args)
{
	my %headers = %{ $args{headers} // {} };
	$headers{Connection} //= 'keep-alive';

	return Protocol::HAP::HTTP::build_response( %args,
		headers => \%headers );
}

# _tlv_response($body):
#	A 200 response with the pairing TLV content type. Every
#	pairing and pairings-management reply uses it.
sub _tlv_response ($body)
{
	return _response(
		status  => 200,
		headers => { 'Content-Type' => 'application/pairing+tlv8' },
		body    => $body,
	);
}

# _char_status($aid, $iid, $code):
#	One per-characteristic result entry for the characteristics
#	endpoints [HAP-HTTP].
sub _char_status ( $aid, $iid, $code )
{
	return { aid => $aid + 0, iid => $iid + 0, status => $code };
}

# $class->new(%args):
#	name, pin, setup_id, category - the accessory identity.
#	store, logger, output, after, cancel, on_pairing_changed - the
#	host contracts of Protocol/HAP.pod. store and output are
#	required; after and cancel are optional, and without them the
#	host calls flush_events itself.
sub new ( $class, %args )
{
	my $pin = normalize_setup_code( $args{pin} )
	    // die 'valid pin required';
	my $store  = $args{store}  // die 'store required';
	my $output = $args{output} // die 'output required';

	my $self = bless {
		pin      => $pin,
		name     => $args{name} // 'OpenHAP Bridge',
		setup_id => $args{setup_id},         # Optional 4-char setup ID
		category => $args{category} // 2,    # Bridge

		# The host contracts
		store  => $store,
		logger => $args{logger} // Protocol::HAP->null_logger,
		output => $output,
		after  => $args{after},
		cancel => $args{cancel},
		on_pairing_changed => $args{on_pairing_changed},

		bridge  => undef,
		pairing => undef,

		accessory_ltsk => undef,
		accessory_ltpk => undef,

		# Session ids come from an instance counter. Two engines
		# in one process never share one.