package EV::Websockets;
use strict;
use warnings;

use EV;

BEGIN {
    use XSLoader;
    our $VERSION = '0.10';
    XSLoader::load __PACKAGE__, $VERSION;
}

package EV::Websockets::Context;

# Parse a proxy value (typically from *_proxy env vars) into ($host, $port).
# Accepts an optional scheme prefix and userinfo, plain host:port, and IPv6
# bracket notation. Returns an empty list if no host can be extracted; the
# port defaults to 1080 when the value carries a host but no explicit port.
sub _parse_proxy {
    my ($url) = @_;
    return unless defined $url && length $url;
    return unless $url =~ m{^(?:\w+://)?(?:[^@]+\@)?(\[[\w:]+\]|[^:/]+)(?::(\d+))?};
    # Capture before the substitution below: a successful s/// resets $2.
    my ($host, $port) = ($1, $2);
    # Strip IPv6 brackets: lws wants a bare proxy host (the port is passed
    # separately), matching how connect() unwraps bracketed URL hosts.
    $host =~ s/^\[(.*)\]\z/$1/;
    return ($host, defined $port ? $port : 1080);
}

sub new {
    my ($class, %args) = @_;
    my $loop = $args{loop} // EV::default_loop;

    my $proxy      = $args{proxy};
    my $proxy_port = $args{proxy_port};

    if (!defined $proxy) {
        my $env_proxy = $ENV{https_proxy} // $ENV{http_proxy} // $ENV{all_proxy};
        my ($host, $port) = _parse_proxy($env_proxy);
        if (defined $host) {
            $proxy      = $host;
            $proxy_port = $port;
        }
    }

    $proxy      //= "";
    $proxy_port //= 0;

    return $class->_new($loop, $proxy, $proxy_port,
        $args{ssl_cert} // "", $args{ssl_key} // "", $args{ssl_ca} // "",
        exists $args{ssl_init} ? ($args{ssl_init} ? 1 : 0) : -1);
}

package EV::Websockets::Connection;

1;

__END__

=encoding utf-8

=head1 NAME

EV::Websockets - WebSocket client/server using libwebsockets and EV

=head1 SYNOPSIS

    use EV;
    use EV::Websockets;

    my $ctx = EV::Websockets::Context->new(loop => EV::default_loop);

    my $conn = $ctx->connect(
        url        => 'ws://example.com/ws',
        on_connect => sub {
            my ($conn) = @_;
            $conn->send("Hello, WebSocket!");
        },
        on_message => sub {
            my ($conn, $data) = @_;
            print "Got: $data\n";
        },
        on_close   => sub {
            my ($conn, $code, $reason) = @_;
            print "Closed: $code " . ($reason // "") . "\n";
        },
        on_error   => sub {
            my ($conn, $err) = @_;
            print "Error: $err\n";
        },
    );

    EV::run;

=head1 DESCRIPTION

EV::Websockets provides WebSocket client and server functionality using the
libwebsockets C library integrated with the EV event loop.

This module uses libwebsockets' foreign loop integration to run within an
existing EV event loop, making it suitable for applications already using EV.
The context services libwebsockets without blocking, so idle connections (or a
context with no connections at all) never stall other EV watchers such as your
own timers and I/O.

=head1 CLASSES

=head2 EV::Websockets::Context

Manages the libwebsockets context and event loop integration.

=head3 new(%options)

Create a new context.

    my $ctx = EV::Websockets::Context->new(
        loop       => EV::default_loop,  # optional, defaults to EV::default_loop
        ssl_cert   => 'client.pem',      # optional, for mTLS client certificates
        ssl_key    => 'client-key.pem',  # required if ssl_cert is set
        ssl_ca     => 'ca.pem',          # optional CA chain
        proxy      => '192.168.1.1',     # optional HTTP proxy host
        proxy_port => 8080,              # optional proxy port (default: 1080)
        ssl_init   => 0,                 # optional, skip OpenSSL global init
    );

If C<proxy> is not specified, the module reads C<https_proxy>, C<http_proxy>,
or C<all_proxy> from the environment. Pass C<< proxy => "" >> to suppress
auto-detection.

C<ssl_init> controls whether this module initializes libwebsockets' global
OpenSSL state. By default it is initialized once and then pinned for the
lifetime of the process, so contexts may be created and destroyed (and new
ones created) freely without tearing OpenSSL down. Pass C<< ssl_init => 0 >>
when coexisting with another TLS library (e.g. Feersum/picotls) that owns the
OpenSSL global state, so this module leaves it untouched.

=head3 connect(%options)

Create a new WebSocket connection.

    my $conn = $ctx->connect(
        url              => 'wss://example.com/ws',
        protocol         => 'chat',              # optional subprotocol
        headers          => { Authorization => 'Bearer token' },
        ssl_verify       => 1,                   # 0 to disable TLS verification
        max_message_size => 1048576,             # optional, 0 = unlimited
        connect_timeout  => 5.0,                 # optional, seconds
        on_connect  => sub { my ($conn, $headers) = @_; ... },
        on_message  => sub { my ($conn, $data, $is_binary) = @_; ... },
        on_close    => sub { my ($conn, $code, $reason) = @_; ... },
        on_error    => sub { my ($conn, $err) = @_; ... },
        on_pong     => sub { my ($conn, $payload) = @_; ... },
        on_drain    => sub { my ($conn) = @_; ... },
    );

Returns an L<EV::Websockets::Connection> object.

C<on_message> receives complete reassembled messages; fragmented frames are
buffered internally up to C<max_message_size>. For backwards compatibility a
fourth argument C<$is_final> is also passed but is always C<1>.

C<connect_timeout> sets a deadline (in seconds) for the WebSocket handshake.
If the connection is not established within this time, C<on_error> fires with
C<"connect timeout"> and the connection is closed.

C<$headers> in C<on_connect> is a hashref of response headers from the server
(Set-Cookie, Content-Type, Server, Sec-WebSocket-Protocol, and when available
Location, WWW-Authenticate).

C<on_drain> fires from the writeable callback when the send queue empties.
It will B<not> fire if C<close()> has already been queued - once closing is
in progress the connection short-circuits to teardown without emitting drain.
If you need to act after the queue empties, do so before calling C<close()>,
or rely on C<on_close> instead.

=head3 listen(%options)

Create a WebSocket listener. Returns the port number being listened on
(useful if port 0 was requested).

    my $port = $ctx->listen(
        port             => 0,          # 0 to let OS pick a port
        name             => 'server',   # optional vhost name (default: 'server')
        protocol         => 'chat',     # optional WebSocket subprotocol
        ssl_cert         => 'cert.pem', # optional, enables TLS
        ssl_key          => 'key.pem',  # required if ssl_cert is set
        ssl_ca           => 'ca.pem',   # optional CA chain
        max_message_size => 1048576,    # optional, 0 = unlimited
        headers          => { 'Set-Cookie' => 'session=abc123' }, # response headers
        on_handshake => sub { my ($headers) = @_; return { 'X-Custom' => 'val' } },
        on_connect  => sub { my ($conn, $headers) = @_; ... },
        on_message  => sub { my ($conn, $data, $is_binary) = @_; ... },
        on_close    => sub { my ($conn, $code, $reason) = @_; ... },
        on_error    => sub { my ($conn, $err) = @_; ... },
        on_pong     => sub { my ($conn, $payload) = @_; ... },
        on_drain    => sub { my ($conn) = @_; ... },
    );

C<protocol> sets the WebSocket subprotocol name advertised by the server vhost.
The vhost name C<default> is reserved and will croak if used.

C<ssl_cert> and C<ssl_key> must be given together; supplying only one croaks
rather than silently falling back to a plaintext listener.

Listeners do not negotiate C<permessage-deflate>: compression is offered on
outgoing client connections (see C<connect>) but not by the server side, so
messages sent to clients are uncompressed. A plain (non-upgrade) HTTP request
to a listener is answered with C<426 Upgrade Required> and closed.

C<$headers> in C<on_connect> is a hashref of client request headers
(Path, Host, Origin, Cookie, Authorization, Sec-WebSocket-Protocol,
User-Agent, X-Forwarded-For).
C<Path> is the request URI (e.g., C</chat>).

C<headers> is an optional hashref of headers to inject into the HTTP upgrade
response (e.g., C<Set-Cookie>).

C<on_handshake> fires before the 101 response is sent
(at C<LWS_CALLBACK_FILTER_PROTOCOL_CONNECTION>). It receives a hashref of
request headers (same keys as C<on_connect>). Return a hashref to inject
per-connection response headers into the upgrade response. Return a false
value (C<undef>, C<0>, C<"">) to reject the connection (the client receives
a 403).

=head3 connections

Returns a list of Connection objects whose state is C<"connected"> or
C<"closing"> (i.e. the WebSocket handshake completed and the underlying
wsi still exists). Conns still in C<"connecting"> and conns already
C<"closed">/C<"destroyed"> are omitted.

    my @conns = $ctx->connections;
    $_->send("broadcast!") for @conns;

=head3 adopt(%options)

Adopt an existing IO handle. C<fh> must be a connected socket; any other
handle (pipe, file, terminal) croaks rather than being taken over.

    my $conn = $ctx->adopt(
        fh               => $socket_handle,
        initial_data     => $already_read_bytes, # optional pre-read data
        max_message_size => 1048576,
        on_connect => sub { my ($conn, $headers) = @_; ... },
        on_message => sub { my ($conn, $data, $is_binary) = @_; ... },
        on_close   => sub { my ($conn, $code, $reason) = @_; ... },
        on_error   => sub { my ($conn, $err) = @_; ... },
        on_pong    => sub { my ($conn, $payload) = @_; ... },
        on_drain   => sub { my ($conn) = @_; ... },
    );

Once adopted, C<libwebsockets> takes ownership of the file descriptor.
The module holds a reference to the Perl handle until the connection is
destroyed, preventing premature fd closure. C<$headers> in C<on_connect>
is always C<undef> for adopted connections.

Adopted connections cannot select a WebSocket subprotocol: lws uses the first
protocol registered on the auto-created C<server> vhost. There is no
C<protocol> option (unlike C<connect> and C<listen>).

If you already read data from the socket (e.g., the HTTP upgrade request),
pass it via C<initial_data> so lws can process the handshake.

=head2 EV::Websockets::Connection

Represents a WebSocket connection.

=head3 send($data)

Queue a text frame. Croaks if the connection is not open.

=head3 send_binary($data)

Queue a binary frame. Croaks if the connection is not open.

=head3 send_ping([$payload])

Queue a Ping frame. C<$payload> is optional; if supplied it is silently
truncated to 125 bytes per RFC 6455 §5.5. Croaks if the connection is not
open.

=head3 send_pong([$payload])

Queue a Pong frame. Same payload rules as C<send_ping>. Most peers send Pong
automatically in response to Ping; you only need this to send an unsolicited
Pong (e.g. as a one-way keepalive).

=head3 send_fragment($data, $is_binary = 0, $is_final = 1)

Send one fragment of a streaming message. The first call starts a new
fragmented message (text or binary per C<$is_binary>); subsequent calls send
continuation frames. Set C<$is_final> true on the last fragment.

    $conn->send_fragment("part1", 0, 0);   # text, not final
    $conn->send_fragment("part2", 0, 0);   # continuation, not final
    $conn->send_fragment("part3", 0, 1);   # continuation, final

C<$is_binary> is honoured only on the first fragment, which fixes the message
type; it is ignored on continuation frames (they are always sent as
continuations), per RFC 6455 §5.4.

Use this only if you need to interleave outbound writes with other I/O while
streaming a single message. For ordinary sends, prefer C<send>/C<send_binary>.

=head3 send_queue_size

Returns the number of payload bytes currently queued for sending (excludes
WebSocket framing overhead). Useful for backpressure monitoring; pair with
C<on_drain> to gate further sends. Returns C<0> on a closed connection (it
does not croak), so it is safe to poll from cleanup paths.

=head3 stash

Returns a hashref for storing arbitrary per-connection metadata. The hashref
is lazily created on first access and lives until the connection is freed.

    $conn->stash->{user_id} = 42;
    my $uid = $conn->stash->{user_id};

=head3 get_protocol

Returns the negotiated C<Sec-WebSocket-Protocol> value, or C<undef> if no
subprotocol was negotiated or the connection is closed.

=head3 peer_address

Returns the peer's IP address as a printable string (IPv4 dotted-quad or
IPv6 colon notation, no brackets, no port), or C<undef> if unavailable.

=head3 close([$code = 1000], [$reason])

Initiate a clean WebSocket close. Sends a Close frame with C<$code> (default
1000, normal closure) and an optional UTF-8 C<$reason> (truncated by lws to
fit the frame). Pending sends are drained first, then the connection is torn
down and C<on_close> fires.

C<$code> is validated against RFC 6455: only 1000-1003, 1007-1014 and
3000-4999 may be sent. Anything else (including the reserved 1004, 1005,
1006 and 1015, or a value outside 16 bits) croaks rather than putting an
invalid code on the wire.

This is a no-op (does not croak) if the connection is already closed,
closing, or destroyed. It is also a no-op while the connection is still
in the C<"connecting"> state - calling C<close()> before the handshake
completes does not cancel the in-flight connect; use C<connect_timeout>
to bound the handshake instead.

=head3 pause_recv

Stop reading frames from this connection (TCP flow control). New incoming
frames will back up in the kernel's socket buffer until C<resume_recv> is
called. Silently does nothing on a closed or destroyed connection.

=head3 resume_recv

Resume receiving after C<pause_recv>. Silently does nothing on a closed or
destroyed connection.

=head3 is_connected

Returns true while C<state> is C<"connected">.

=head3 is_connecting

Returns true while C<state> is C<"connecting">. Returns false once the
connection is established, closing, closed, or destroyed.

=head3 state

Returns the current state as one of:

=over 4

=item C<"connecting"> - TCP/TLS handshake or HTTP upgrade in progress

=item C<"connected"> - open and ready to send/receive

=item C<"closing"> - C<close()> has been called; pending sends still draining

=item C<"closed"> - the underlying wsi is gone but the Perl object is still alive

=item C<"destroyed"> - the C struct has been freed (further method calls will croak)

=back

=head1 DEBUGGING

    EV::Websockets::_set_debug(1);

Enables verbose debug output from both the module and libwebsockets.
In tests, gate on C<$ENV{EV_WS_DEBUG}>:

    EV::Websockets::_set_debug(1) if $ENV{EV_WS_DEBUG};

=head1 FEERSUM INTEGRATION

Adopt WebSocket connections from a Feersum PSGI server via C<psgix.io>:

    use Feersum;
    use EV::Websockets;

    my $ctx = EV::Websockets::Context->new;
    my $feersum = Feersum->endjinn;
    $feersum->set_psgix_io(1);

    $feersum->psgi_request_handler(sub {
        my $env = shift;
        return [400,[],[]] unless ($env->{HTTP_UPGRADE}//'') =~ /websocket/i;

        my $io = $env->{'psgix.io'};

        # Reconstruct HTTP upgrade for lws
        my $path = $env->{REQUEST_URI} // '/';
        my $hdr = "GET $path HTTP/1.1\r\n";
        for (sort keys %$env) {
            next unless /^HTTP_(.+)/;
            (my $h=$1) =~ s/_/-/g;
            $hdr .= "$h: $env->{$_}\r\n";
        }
        $hdr .= "\r\n";

        $ctx->adopt(fh => $io, initial_data => $hdr,
            on_message => sub { $_[0]->send($_[1]) },  # echo
        );
        return;
    });

See also C<eg/feersum_native.pl> and C<eg/feersum_psgi.pl> for full examples.

=head1 BENCHMARKS

The C<bench/> directory contains latency and throughput benchmarks.

    # Echo round-trip latency (native client + native server)
    perl bench/latency.pl

    # Throughput (messages/sec)
    perl bench/throughput.pl

    # Comparison with AnyEvent::WebSocket and Net::WebSocket::EVx
    perl bench/compare.pl

Typical results on Linux (localhost, 1000 round-trips, 64-byte payload):

    EV::Websockets          ~10us avg,  ~97k msg/s  (C/libwebsockets)
    Net::WebSocket::EVx     ~10us avg,  ~96k msg/s  (C/wslay)
    Mojolicious             ~83us avg,  ~12k msg/s  (Pure Perl)
    Net::Async::WebSocket  ~141us avg,   ~7k msg/s  (Pure Perl)

=head1 URL FORMATS

C<connect> accepts C<ws://> (plaintext) and C<wss://> (TLS) URLs:

    ws://host[:port]/path
    wss://host[:port]/path
    ws://[2001:db8::1]:9001/         # IPv6 (brackets required)

The default port is 80 for C<ws://> and 443 for C<wss://>. Userinfo
(C<user:pass@>) in the URL is not parsed; pass HTTP auth via the
C<headers> option instead.

=head1 ERRORS AND EXCEPTIONS

Methods on L</EV::Websockets::Connection> fall into two groups:

=over 4

=item Send / accessors that croak when the connection is gone

C<send>, C<send_binary>, C<send_ping>, C<send_pong>, C<send_fragment>, and
C<stash> croak with C<"Connection has been destroyed"> or C<"Connection is
not open"> if invoked after the connection has closed or been DESTROYed.
Wrap in C<eval { ... }> if you may race connection teardown.

=item Lifecycle / control that silently no-op

C<close>, C<pause_recv>, and C<resume_recv> return silently when the
connection is already closed or destroyed. This makes them safe to call
from cleanup paths without guarding.

=back

User-supplied callbacks (C<on_connect>, C<on_message>, C<on_close>,
C<on_error>, C<on_pong>, C<on_drain>, C<on_handshake>) are invoked under
C<G_EVAL>: a die inside a callback is caught, warned, and the connection
continues. The exception is C<on_handshake>, which gates the upgrade: a die
there rejects the connection (the client receives a 403), exactly as if the
callback had returned a false value. C<on_error> is itself wrapped, so a die
inside C<on_error> will not recurse.

=head1 SEE ALSO

L<EV>, L<Alien::libwebsockets>, L<libwebsockets|https://libwebsockets.org/>,
L<Net::WebSocket::EVx>, L<AnyEvent::WebSocket::Client>

=head1 AUTHOR

vividsnow

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
