view release on metacpan or  search on metacpan

t/anyevent_websocket_client.t  view on Meta::CPAN

      my $uri = $uri->clone;
      my $port = $uri->port;
      $uri->port($port+1);
      my @args = ($uri, undef, $port);
      note "args=$_" for map { defined $_ ? $_ : 'undef' } @args;

      my $connection = eval { AnyEvent::WebSocket::Client->new->connect(@args)->recv };
      is $@, '', 'connect okay';

    };

    subtest 'port' => sub {

      my $uri = $uri->clone;
      my $host = $uri->host;
      my $port = $uri->port;
      $uri->host("bogus.test");
      $uri->port($port+1);
      my @args = ($uri, $host, $port);
      note "args=$_" for @args;

      my $connection = eval { AnyEvent::WebSocket::Client->new->connect(@args)->recv };
      is $@, '', 'connect okay';

    };

  };

  subtest 'version' => sub {

    my $connection = AnyEvent::WebSocket::Client->new(
      protocol_version => 'draft-ietf-hybi-10',
    )->connect($uri)->recv;

    is $last_handshake->version, 'draft-ietf-hybi-10', 'server side protool_version = draft-ietf-hybi-10';
  };

  subtest 'subprotocol' => sub {

    is(
      AnyEvent::WebSocket::Client->new( subprotocol => ['foo','bar','baz'] )->subprotocol,
      ['foo','bar','baz'],
    );

    is(
      AnyEvent::WebSocket::Client->new( subprotocol => ['foo'] )->subprotocol,
      ['foo'],
    );

    is(
      AnyEvent::WebSocket::Client->new( subprotocol => 'foo' )->subprotocol,
      ['foo'],
    );

    my $connection = AnyEvent::WebSocket::Client->new(subprotocol => ['foo','bar','baz'])->connect($uri)->recv;
    is($last_handshake->res->subprotocol, 'bar', 'server agreed to bar');
    is($connection->subprotocol, 'bar', 'connection also has bar');

    eval { AnyEvent::WebSocket::Client->new(subprotocol => ['foo','baz'])->connect($uri)->recv };
    my $error = $@;
    like $error, qr{no subprotocol in response}, 'bad protocol throws an exception';

    eval { AnyEvent::WebSocket::Client->new(subprotocol => ['klingon','cardasian'])->connect($uri)->recv };
    $error = $@;
    like $error, qr{subprotocol mismatch, requested: klingon, cardasian, got: romulan}, 'bad protocol throws an exception';

  };

  subtest http_headers => sub {

    is(
      AnyEvent::WebSocket::Client->new( http_headers => { 'X-Foo' => 'bar', 'X-Baz' => [ 'abc', 'def' ] } )->http_headers,
      [ 'X-Baz' => 'abc',
        'X-Baz' => 'def',
        'X-Foo' => 'bar', ]
    );

    my $client = AnyEvent::WebSocket::Client->new( http_headers => [ 'X-Foo' => 'bar', 'X-Baz' => 'abc', 'X-Baz' => 'def' ] );

    is(
      $client->http_headers,
      [  'X-Foo' => 'bar',
         'X-Baz' => 'abc',
         'X-Baz' => 'def',  ]
    );

    # Note: Protocol::WebSocket does not currently support headers with multiple instances of the same
    # key, so we just won't test that.
    $client = AnyEvent::WebSocket::Client->new( http_headers => [ 'X-Foo' => 'bar', 'X-Baz' => 'abc' ] );
    my $connection = $client->connect($uri)->recv;

    is($last_handshake->req->fields->{'x-foo'}, 'bar');
    is($last_handshake->req->fields->{'x-baz'}, 'abc');

  };
};

subtest 'Client Connection should set masked => true' => sub {

  my $uri = start_echo;

  my $connection = AnyEvent::WebSocket::Client->new()->connect($uri)->recv;
  ok $connection->masked, "Client Connection should set masked => true";

};

subtest 'payload size' => sub {

  my $uri = start_echo;

  my $client = AnyEvent::WebSocket::Client->new( max_payload_size => 65538 );

  subtest 'connection gets same max_payload_size as client' => sub {

    my $connection = $client->connect($uri)->recv;
    is $connection->max_payload_size, 65538;

  };

  subtest 'send message > 65536' => sub {

    my $data = 'x' x 65537;

    my $connection = $client->connect($uri)->recv;