view release on metacpan or  search on metacpan

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

	my $custom = Protocol::HAP::HTTP::build_response(
		status      => 470,
		status_text => 'Connection Authorization Required',
	);
	like( $custom, qr{^HTTP/1\.1 470 Connection Authorization Required\r\n},
		'a caller can name a reason the codec does not know' );
	like( Protocol::HAP::HTTP::build_response( status => 470 ),
		qr{470 Unknown}, 'and an unknown code alone reads as Unknown' );

	# The header order is stable, so a conformance test can compare
	# a response byte for byte
	my %args = (
		status  => 200,
		headers => { Zulu => 1, Alpha => 2, Mike => 3 },
	);
	is( Protocol::HAP::HTTP::build_response(%args),
		Protocol::HAP::HTTP::build_response(%args),
		'the same arguments give the same bytes' );
	like(
		Protocol::HAP::HTTP::build_response(%args),
		qr{Alpha: 2\r\nContent-Length: 0\r\nMike: 3\r\nZulu: 1},
		'the headers are sorted'
	);
};

subtest 'status_text' => sub {
	is( Protocol::HAP::HTTP::status_text(200), 'OK', 'the text of 200' );
	is( Protocol::HAP::HTTP::status_text(404), 'Not Found', 'the text of 404' );
	is( Protocol::HAP::HTTP::status_text(413),
		'Content Too Large', 'the text of 413' );
	is( Protocol::HAP::HTTP::status_text(999), 'Unknown', 'an unknown code' );
};

# A stream socket gives a reader whatever arrived, which is not a
# message. Everything below is the framing that a server needs to not
# drop or mangle a request.
subtest 'framing: a message split across reads' => sub {
	my $whole =
	      "POST /characteristics HTTP/1.1\r\n"
	    . "Content-Length: 13\r\n"
	    . "\r\n"
	    . '{"test":true}';

	# One byte at a time. Only the last one completes the message.
	my $buffer = '';
	my @complete;
	for my $byte ( split //, $whole ) {
		$buffer .= $byte;
		push @complete, Protocol::HAP::HTTP::message_complete($buffer);
	}

	is( scalar( grep { $_ } @complete ), 1, 'the message completes once' );
	is( $complete[-1], length($whole), 'at exactly its own length' );

	# Content-Length is found wherever it sits in the block. A
	# pattern anchored with $ under /m stops at the \r of the line
	# terminator, so it would match only the last header and every
	# real response would frame short.
	my $middle =
	      "HTTP/1.1 200 OK\r\n"
	    . "Connection: keep-alive\r\n"
	    . "Content-Length: 5\r\n"
	    . "Content-Type: text/plain\r\n"
	    . "\r\n" . 'hello';
	is( Protocol::HAP::HTTP::message_complete($middle),
		length($middle), 'a header that is not the last one is read' );

	# A message whose headers arrived but whose body has not
	my $headers_only = substr $whole, 0, index( $whole, "\r\n\r\n" ) + 4;
	is( Protocol::HAP::HTTP::message_complete($headers_only),
		0, 'headers with a declared body are not a whole message' );

	my $parsed = Protocol::HAP::HTTP::parse_request($whole);
	is( $parsed->{body}, '{"test":true}', 'and the whole one parses' );
};

subtest 'framing: two messages in one read' => sub {
	my $first =
	    "GET /accessories HTTP/1.1\r\nHost: a\r\n\r\n";
	my $second =
	      "PUT /characteristics HTTP/1.1\r\n"
	    . "Content-Length: 2\r\n"
	    . "\r\n" . '{}';

	my $buffer = $first . $second;

	my $length = Protocol::HAP::HTTP::message_complete($buffer);
	is( $length, length($first), 'the first message ends where it ends' );

	my $one = substr $buffer, 0, $length, '';
	is( Protocol::HAP::HTTP::parse_request($one)->{path},
		'/accessories', 'and it parses' );

	$length = Protocol::HAP::HTTP::message_complete($buffer);
	is( $length, length($second), 'the second message follows' );

	my $two = substr $buffer, 0, $length, '';
	is( Protocol::HAP::HTTP::parse_request($two)->{path},
		'/characteristics', 'and it parses too' );
	is( $buffer, '', 'nothing is left over' );

	is( Protocol::HAP::HTTP::message_complete($buffer),
		0, 'an empty buffer holds no message' );
};

subtest 'framing: a message over the limit' => sub {
	my $body    = 'x' x 200;
	my $request =
	      "POST / HTTP/1.1\r\n"
	    . 'Content-Length: '
	    . length($body)
	    . "\r\n\r\n"
	    . $body;

	ok( Protocol::HAP::HTTP::message_complete( $request, max_size => 1000 ),
		'inside the limit it completes' );

	is( Protocol::HAP::HTTP::message_complete( $request, max_size => 100 ),
		undef, 'over the limit it is refused' );

	# The refusal comes from the declared length, before the body