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 Net::Async::HTTP;

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

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

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

$loop->add( $http );

my $peersock;

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

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

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

{
   my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]);
   $req->content_length( 21 ); # set this manually based on what we plan to send

   my $response;

   my $done = 0;
   $http->do_request(
      request => $req,
      host    => "myhost",

      request_body => sub {
         if( !$done ) {
            pass( "Callback after headers sent" );
            $done++;
            return "Content from callback";
         }
         elsif( $done == 1 ) {
            pass( "Second request seen, returning undef" );
            $done++;
            return undef;
         }
         else {
            fail( "called request_body too many times" );
         }
      },

      on_response => sub { $response = $_[0] },
      on_error    => sub { die "Test died early - $_[0]" },
   );


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

   $request_stream =~ s/^(.*)$CRLF//;
   my $req_firstline = $1;

   is( $req_firstline, "PUT /handler HTTP/1.1", 'First line for streaming PUT' );

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

   is_deeply( \%req_headers,
      {
         'Host'           => "somewhere",
         'Content-Length' => 21,
         'Connection'     => 'keep-alive',
      },
      'Request headers for streaming PUT'
   );

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

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

   is( $req_content, "Content from callback", 'Request content for streaming PUT' );

   $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . 
                        "Content-Length: 0$CRLF" .
                        "Connection: Keep-Alive$CRLF" .
                        $CRLF );

   wait_for { defined $response };

   is( $response->code, 201, 'Result code for streaming PUT' );

   my %res_headers = map { $_ => $response->header( $_ ) } $response->header_field_names;
   is_deeply( \%res_headers,
      {
         'Content-Length' => 0,
         'Connection'     => "Keep-Alive",
      },
      'Result headers for streaming PUT'
   );
}

{
   my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]);
   $req->content_length( 15 );

   my $body_f = $loop->new_future;

   my $response;
   $http->do_request(
      request      => $req,
      request_body => $body_f,
      host         => "myhost",

      on_response => sub { $response = $_[0] },
      on_error    => sub { die "Test died early - $_[0]" },
   );

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

   $body_f->done( "Delayed content" );

   wait_for_stream { length $request_stream >= 15 } $peersock => $request_stream;

   is( $request_stream, "Delayed content" );

   $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . 
                        "Content-Length: 0$CRLF" .
                        "Connection: Keep-Alive$CRLF" .
                        $CRLF );

   wait_for { defined $response };

   is( $response->code, 201, 'Result code for streaming PUT from Future' );
}

done_testing;