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 IO::Async::SSL;

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

testing_loop( $loop );

my $listen_sock = IO::Socket::INET->new(
   LocalHost => "localhost",
   LocalPort => 0,
   Listen => 1,
) or die "Cannot listen - $@";

# Mass cheating here
no warnings 'redefine';
*IO::Socket::SSL::connect_SSL = sub {
   return 1;
};

my $f = $loop->SSL_connect(
   addr => { family => "inet", ip => $listen_sock->sockhost, port => $listen_sock->sockport },
);

wait_for { $f->is_ready };

my $stream = $f->get;

my $server_sock = $listen_sock->accept;

my $read;
$stream->configure(
   on_read => sub {
      my ( $self, $readbuf ) = @_;
      $read = $$readbuf; $$readbuf = "";
      return 0;
   },
);
$loop->add( $stream );

# A micro mocking framework
{
   my @EXPECT;
   sub expect
   {
      my ( $method, $args, $result, $return ) = @_;
      push @EXPECT, [ $method, $args, $result, $return ];
   }

   *IO::Socket::SSL::sysread = sub {
      my ( $fh, undef, $len, $offset ) = @_;
      @EXPECT or
         fail( "Expected no more calls, got sysread" ), $! = Errno::EINVAL, return undef;

      my $e = shift @EXPECT;
      $e->[0] eq "sysread" or
         fail( "Expected $e->[0], got sysread" ), $! = Errno::EINVAL, return undef;

      pass( "Got sysread" );

      if( $e->[2] eq "return" ) {
         $_[1] = $e->[3];
         return length $e->[3];
      }
      elsif( $e->[2] eq "err" ) {
         $! = Errno::EAGAIN;
         $IO::Socket::SSL::SSL_ERROR = $e->[3];
         return undef;
      }
   };

   *IO::Socket::SSL::syswrite = sub {
      my ( $fh, $buff, $len ) = @_;
      @EXPECT or
         fail( "Expected no more calls, got syswrite" ), $! = Errno::EINVAL, return undef;

      my $e = shift @EXPECT;
      $e->[0] eq "syswrite" or
         fail( "Expected $e->[0], got syswrite" ), $! = Errno::EINVAL, return undef;

      pass( "Got syswrite" );

      is( $e->[1][0], $buff, 'Data for syswrite' );

      if( $e->[2] eq "return" ) {
         return $len;
      }
      elsif( $e->[2] eq "err" ) {
         $! = Errno::EAGAIN;
         $IO::Socket::SSL::SSL_ERROR = $e->[3];
         return undef;
      }
   };
}

# read-wants-read
{
   # Make serversock readready
   $server_sock->syswrite( "1" );

   expect sysread => [], return => "the data";

   wait_for { length $read };

   is( $read, "the data", 'read-wants-read reads data' );

   $read = "";
   CORE::sysread( $stream->read_handle, my $dummy, 8192 );
}

# read-wants-write
{
   # Make serversock readready
   $server_sock->syswrite( "2" );

   expect sysread => [], err => IO::Socket::SSL::SSL_WANT_WRITE;

   wait_for { $stream->want_writeready };

   pass( '$stream->want_writeready' );
   CORE::sysread( $stream->read_handle, my $dummy, 8192 );

   expect sysread => [], return => "late data";

   wait_for { length $read };

   is( $read, "late data", 'read-wants-write reads data after writeready' );

   $read = "";
}

# write-wants-write
{
   my $flushed;
   $stream->write( "out data", on_flush => sub { $flushed++ } );

   expect syswrite => [ "out data" ], return =>;

   wait_for { $flushed };

   pass( 'write-wants-write flushes data' );
}

# write-wants-read
{
   my $flushed;
   $stream->write( "late out data", on_flush => sub { $flushed++ } );

   # more cheating
   $stream->want_readready( 0 );

   expect syswrite => [ "late out data" ], err => IO::Socket::SSL::SSL_WANT_READ;

   wait_for { $stream->want_readready };

   pass( '$stream->want_readready' );

   expect sysread  => [], err => 0;
   expect syswrite => [ "late out data" ], return =>;

   $server_sock->syswrite( "4" );

   wait_for { $flushed };

   pass( 'write-wants-read flushes data after readready' );
}

done_testing;