view release on metacpan or  search on metacpan

t/17-transport-tuning.t  view on Meta::CPAN

        active_connection_id_limit  => 4,
        disable_active_migration    => 0,
    },
    'transport overrides reach ngtcp2',
);

like(
    dies { make_client(transport => 'not-a-hash') },
    qr/transport must be a hash reference/,
    'transport must be a hash reference',
);

like(
    dies { make_client(transport => { mystery => 1 }) },
    qr/unknown transport option: mystery/,
    'unknown transport option is rejected',
);

like(
    dies { make_client(transport => { handshake_timeout => 0 }) },
    qr/handshake_timeout must be greater than zero/,
    'zero handshake timeout is rejected',
);

like(
    dies { make_client(transport => { max_bidi_streams => -1 }) },
    qr/max_bidi_streams must be a non-negative integer/,
    'negative stream count is rejected',
);

my $short_handshake = make_client(
    transport => {
        handshake_timeout => 0.02,
    },
);

my $hard_deadline = time() + 1;

while (!defined($short_handshake->connection->close_info)
       && time() < $hard_deadline) {
    my $after = $short_handshake->timeout_after;

    if (!defined $after) {
        sleep(0.001);
        next;
    }

    sleep($after) if $after > 0;
    $short_handshake->handle_timeout;
}

is(
    $short_handshake->connection->close_info->{type},
    'handshake',
    'configured handshake timeout becomes a handshake close outcome',
);

my $server = Net::QUIC::Endpoint->server(
    alpn             => $alpn,
    certificate_file => $cert_file,
    private_key_file => $key_file,
    transport        => {
        max_bidi_streams => 1,
        max_uni_streams  => 1,
    },
);

my $client = make_client();
my $accepted;

sub pump_pair {
    my $progress = 0;

    while (my $datagram = $server->next_datagram) {
        ++$progress;
        $client->receive_datagram(
            $datagram->data,
            $client_local,
            $server_local,
        );
    }

    while (my $datagram = $client->next_datagram) {
        ++$progress;
        $server->receive_datagram(
            $datagram->data,
            $server_local,
            $client_local,
        );
    }

    my $server_after = $server->timeout_after;
    if (defined($server_after) && $server_after <= 0) {
        ++$progress;
        $server->handle_timeout;
    }

    my $client_after = $client->timeout_after;
    if (defined($client_after) && $client_after <= 0) {
        ++$progress;
        $client->handle_timeout;
    }

    if (!$progress) {
        my @wait = sort { $a <=> $b }
            grep { defined($_) && $_ > 0 }
            ($server_after, $client_after);

        if (@wait) {
            my $nap = $wait[0] > 0.01 ? 0.01 : $wait[0] + 0.001;
            sleep($nap);
            ++$progress;
        }
    }

    return $progress;
}

for (1 .. 500) {
    pump_pair();
    $accepted ||= $server->next_connection;