The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use IO::Async::Test;
use IO::Async::Loop;

use HTTP::Cookies;

use Net::Async::HTTP;

my $CRLF = "\x0d\x0a"; # because \r\n isn't portable

my $loop = IO::Async::Loop->new();
testing_loop( $loop );

my $cookie_jar = HTTP::Cookies->new;

my $http = Net::Async::HTTP->new(
   user_agent => "", # Don't put one in request headers
   cookie_jar => $cookie_jar,
);

$loop->add( $http );

my $peersock;

sub do_test_req
{
   my $name = shift;
   my %args = @_;

   no warnings 'redefine';
   local *IO::Async::Handle::connect = sub {
      my $self = shift;
      my %args = @_;

      $args{host}    eq "myhost" or die "Expected $args{host} eq myhost";
      $args{service} eq "80"     or die "Expected $args{service} eq 80";

      ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
      $self->set_handle( $selfsock );

      return Future->new->done( $self );
   };

   my $response;
   my $error;

   my $request = $args{req};

   $http->do_request(
      request => $request,
      host    => "myhost",

      on_response => sub { $response = $_[0] },
      on_error    => sub { $error    = $_[0] },
   );

   # Wait for the client to send its request
   my $request_stream = "";
   wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream;

   # Ignore first line
   $request_stream =~ s/^(.*)$CRLF//;

   $request_stream =~ s/^(.*)$CRLF$CRLF//s;
   my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 );

   my $req_content;
   if( defined( my $len = $req_headers{'Content-Length'} ) ) {
      wait_for { length( $request_stream ) >= $len };

      $req_content = substr( $request_stream, 0, $len );
      substr( $request_stream, 0, $len ) = "";
   }

   my $expect_req_headers = $args{expect_req_headers};

   foreach my $header ( keys %$expect_req_headers ) {
      is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" );
   }

   $peersock->syswrite( $args{response} );

   # Wait for the server to finish its response
   wait_for { defined $response or defined $error };

   my %h = map { $_ => $response->header( $_ ) } $response->header_field_names;

   is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" );
}

my $req;

$req = HTTP::Request->new( GET => "http://myhost/", [ Host => "myhost" ] );

do_test_req( "set cookie",
   req => $req,

   expect_req_headers => {
      Host => "myhost",
   },

   response => "HTTP/1.1 200 OK$CRLF" .
               "Set-Cookie: X_TEST=MyCookie; path=/$CRLF" .
               "Content-Length: 0$CRLF" .
               $CRLF,

   expect_res_headers => {
      'Content-Length' => 0,
      'Set-Cookie'     => "X_TEST=MyCookie; path=/",
   },
);

$req = HTTP::Request->new( POST => "http://myhost/", [ Host => "myhost" ] );

do_test_req( "get cookie",
   req => $req,

   expect_req_headers => {
      Host   => "myhost",
      Cookie  => "X_TEST=MyCookie",
      Cookie2 => '$Version="1"',
      'Content-Length' => 0,
   },

   response => "HTTP/1.1 200 OK$CRLF" .
               "Content-Length: 0$CRLF" .
               $CRLF,

   expect_res_headers => {
      'Content-Length' => 0,
   },
);

done_testing;