App-OpenHAP

 view release on metacpan or  search on metacpan

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

subtest '[HAP-HTTP §2] content types' => sub {
	my $hap = make_hap();

	my $m1 = Protocol::HAP::TLV::encode(
		Protocol::HAP::Pairing::kTLVType_State(),  pack( 'C', 1 ),
		Protocol::HAP::Pairing::kTLVType_Method(), pack( 'C', 0 ),
	);
	my ( undef, $headers, undef ) =
	    dispatch( $hap, 'POST', '/pair-setup', $m1,
		$hap->session_open );
	is( $headers->{'content-type'},
		'application/pairing+tlv8',
		'pairing endpoints use application/pairing+tlv8' );

	( undef, $headers, undef ) = dispatch( $hap, 'GET', '/accessories' );
	is( $headers->{'content-type'},
		'application/hap+json',
		'accessory endpoints use application/hap+json' );
};

subtest '[HAP-HTTP §3] POST /identify paired vs unpaired' => sub {
	my $hap = make_hap();
	my $unverified = $hap->session_open;

	my ( $status, undef, undef ) =
	    dispatch( $hap, 'POST', '/identify', undef, $unverified );

t/openhap/integration/events.t  view on Meta::CPAN

# Positive wait: bounded by the session timeout (OPENHAP_TEST_TIMEOUT)
my $event = $subscriber->next_event;
ok(defined $event, '[HAP-HTTP §14] EVENT/1.0 message received')
    or diag('no event; buffered plaintext: '
	. unpack('H*', $subscriber->{inbuf} // '')
	. ' raw: ' . unpack('H*', $subscriber->{rawbuf} // ''));

# Decode only a received event. Then a miss stays a normal failure,
# and the unpair teardown below still runs.
is($event ? $event->{headers}{'content-type'} : undef,
   'application/hap+json', '[HAP-HTTP §14] event content type');
my $payload = $event ? eval { decode_json($event->{body}) } : undef;
diag("event body undecodable: $@") if $event && !$payload;
my ($change) = grep { $_->{aid} == $aid && $_->{iid} == $iid }
    @{ $payload ? $payload->{characteristics} : [] };
ok($change, '[HAP-HTTP §14] event carries the changed characteristic');

# Test 3: Subscriptions are per-connection. The unsubscribed
# controller receives nothing.
my $stray = $bystander->next_event(2);

t/openhap/integration/hap-protocol.t  view on Meta::CPAN

my $step1_request = "\x00\x01\x01" . "\x03\x20" . $fake_public_key;
$response = $env->http_request('POST', '/pair-verify', $step1_request,
	{'Content-Type' => 'application/pairing+tlv8'});
ok(defined $response && $response =~ /HTTP\/1\.1\s+200/,
   '/pair-verify step 1 returns HTTP 200');

# Test 16: Error responses use application/hap+json
$response = $env->http_request('PUT', '/characteristics',
	'invalid json',
	{'Content-Type' => 'application/hap+json'});
# Check if the response has a content-type header
my $error_content_type = $response =~ /Content-Type:\s*application\/(hap\+)?json/i;
# Either proper error content-type or 470 unpaired
ok($error_content_type || $response =~ /470/,
   'error responses use appropriate content type');

$env->teardown;

t/protocol/http.t  view on Meta::CPAN

	my $request = Protocol::HAP::HTTP::parse_request(
		    "GET /accessories HTTP/1.1\r\n"
		    . "Host: localhost\r\n"
		    . "Content-Type: application/hap+json\r\n"
		    . "\r\n" );

	is( $request->{method},  'GET',          'the method' );
	is( $request->{path},    '/accessories', 'the path' );
	is( $request->{version}, '1.1',          'the version' );
	is( $request->{headers}{host}, 'localhost', 'a header' );
	is( $request->{headers}{'content-type'},
		'application/hap+json', 'and another' );
	is( $request->{body}, '', 'an empty body' );

	# A peer chooses the case of a header name, so the reader must
	# not depend on it
	my $mixed = Protocol::HAP::HTTP::parse_request(
		"GET / HTTP/1.1\r\nCoNtEnT-tYpE: text/plain\r\n\r\n");
	is( $mixed->{headers}{'content-type'},
		'text/plain', 'a header name is lowercased' );

	my $post = Protocol::HAP::HTTP::parse_request(
		    "POST /characteristics HTTP/1.1\r\n"
		    . "Content-Length: 13\r\n"
		    . "\r\n"
		    . '{"test":true}' );
	is( $post->{method}, 'POST',          'a POST method' );
	is( $post->{body},   '{"test":true}', 'and its body' );