#!/usr/bin/env perl

use strict;
use warnings;

use utf8;

use Test::More;

use Encode;

use_ok 'Protocol::WebSocket::Frame';

my $f = Protocol::WebSocket::Frame->new;

is $f->version, 'draft-ietf-hybi-17';

$f->append;
ok not defined $f->next;
$f->append('');
ok not defined $f->next;

# Not masked
$f->append(pack('H*', "810548656c6c6f"));
is $f->next_bytes, 'Hello';
is $f->opcode => 1;
ok $f->is_text;

# Multi
$f->append(pack('H*', "810548656c6c6f") . pack('H*', "810548656c6c6f"));
is $f->next_bytes, 'Hello';
is $f->next_bytes, 'Hello';

# Masked
$f->append(pack('H*', "818537fa213d7f9f4d5158"));
is $f->next_bytes, 'Hello';
is $f->opcode => 1;

# Fragments
$f->append(pack('H*', "010348656c"));
ok not defined $f->next_bytes;
$f->append(pack('H*', "80026c6f"));
is $f->next_bytes, 'Hello';
is $f->opcode => 1;

# Multi fragments
$f->append(pack('H*', "010348656c") . pack('H*', "80026c6f"));
is $f->next_bytes, 'Hello';
is $f->opcode => 1;

# Injected control frame (1 fragment, ping, 2 fragment)
$f->append(pack('H*', "010348656c"));
$f->append(pack('H*', "890548656c6c6f"));
$f->append(pack('H*', "80026c6f"));
is $f->next_bytes, 'Hello';
is $f->opcode => 9;
is $f->next_bytes, 'Hello';
is $f->opcode => 1;

# Too many fragments
$f->append(pack('H*', "010348656c")) for 1 .. 129;
eval { $f->next_bytes };
ok $@;

# Ping request
$f = Protocol::WebSocket::Frame->new;
$f->append(pack('H*', "890548656c6c6f"));
is $f->next_bytes => 'Hello';
is $f->opcode     => 9;
ok $f->is_ping;

# Ping response
$f->append(pack('H*', "8a0548656c6c6f"));
is $f->next_bytes => 'Hello';
is $f->opcode     => 10;
ok $f->is_pong;

# 256 bytes
$f->append(pack('H*', "827E0100" . ('05' x 256)));
is(length $f->next_bytes, 256);
is $f->opcode => 2;
ok $f->is_binary;

# 64KiB
$f->append(pack('H*', "827F0000000000010000" . ('05' x 65536)));
is(length $f->next_bytes, 65536);
is $f->opcode => 2;

# Too big frame
$f->append(pack('H*', "827F0000000000100000" . ('05' x (65536 + 1))));
eval { $f->next_bytes };
ok $@;

$f = Protocol::WebSocket::Frame->new('Hello');
is $f->to_bytes => pack('H*', "810548656c6c6f");

$f = Protocol::WebSocket::Frame->new(
    buffer => 'Hello',
    masked => 1,
    mask   => '939139389'
);
is $f->to_bytes, pack('H*', "818537fa213d7f9f4d5158");

# Ping
$f = Protocol::WebSocket::Frame->new(buffer => 'Hello', type => 'ping');
is $f->to_bytes => pack('H*', "890548656c6c6f");

# 256 bytes
$f = Protocol::WebSocket::Frame->new(
    buffer => pack('H*', ('05' x 256)),
    type => 'binary'
);
is $f->to_bytes => pack('H*', "827E0100" . ('05' x 256));

# 64KiB bytes
$f = Protocol::WebSocket::Frame->new(
    buffer => pack('H*', ('05' x 65536)),
    type => 'binary'
);
is $f->to_bytes => pack('H*', "827F0000000000010000" . ('05' x 65536));

$f = Protocol::WebSocket::Frame->new;
$f->append(Protocol::WebSocket::Frame->new('привет')->to_bytes);
is $f->next => 'привет';

# Too big
$f = Protocol::WebSocket::Frame->new(
    buffer => pack('H*', ('05' x (65536 + 1))),
    type => 'binary'
);
eval { $f->to_bytes };
ok $@;

# initialize fin flag to zero
$f = Protocol::WebSocket::Frame->new(buffer => 'Hello', fin => 0);
is $f->to_bytes => pack('H*', "010548656c6c6f");

# continuation frame
$f = Protocol::WebSocket::Frame->new(buffer => "Hello", type => "continuation");
is $f->to_bytes => pack('H*', "800548656c6c6f");

# generate fragmented frames
$f = Protocol::WebSocket::Frame->new();
$f->append(
    Protocol::WebSocket::Frame->new(
        buffer => "Hello",
        type   => "binary",
        fin    => 0
    )->to_bytes
);
is $f->next_bytes => undef;
$f->append(
    Protocol::WebSocket::Frame->new(
        buffer => ", ",
        type   => "continuation",
        fin    => 0
    )->to_bytes
);
is $f->next_bytes => undef;
$f->append(
    Protocol::WebSocket::Frame->new(
        buffer => "World!",
        type   => "continuation",
        fin    => 1
    )->to_bytes
);
is $f->next_bytes => "Hello, World!";
is $f->opcode     => 2;

subtest 'constructor type values and is_$type are consistent' => sub {
    my @types = qw(continuation text binary ping pong close);
    foreach my $type (@types) {
        my $f = Protocol::WebSocket::Frame->new(type => $type);
        foreach my $test_type (@types) {
            my $method = "is_$test_type";
            if ($type eq $test_type) {
                ok $f->$method, "type $type $method";
            }
            else {
                ok !$f->$method, "type $type not $method";
            }
        }
    }
};

subtest 'opcode accessor/mutator' => sub {
    my $f = Protocol::WebSocket::Frame->new("Hello");
    is $f->opcode => 1;
    is $f->to_bytes => pack('H*', "810548656c6c6f");

    $f->opcode(2);
    is $f->opcode => 2;
    is $f->to_bytes => pack('H*', "820548656c6c6f");

    $f->opcode(0);
    is $f->opcode => 0;
    is $f->to_bytes => pack('H*', "800548656c6c6f");
};

subtest 'opcode immediately available' => sub {
    my $f = Protocol::WebSocket::Frame->new(buffer => "Hello", opcode => 8);

    is $f->opcode => 8;
    is $f->to_bytes => pack('H*', "880548656c6c6f");
};

subtest 'if both type and opcode are specified in new(), type wins' => sub {
    my $f = Protocol::WebSocket::Frame->new(
        buffer => "Hello",
        type   => "ping",
        opcode => 2
    );

    is $f->opcode => 9;
    is $f->to_bytes => pack('H*', "890548656c6c6f");
};

subtest 'mask frame' => sub {
    foreach my $test_case (
        {label => "foobar", opcode => 9, buffer => "Foobar"},
        {label => "empty", opcode => 1, buffer => ""},
        {label => "character zero", opcode => 2, buffer => "0"},
        {label => "number zero", opcode => 2, buffer => 0},
        {label => "number 123", opcode => 1, buffer => 123},
    ) {
        my $f = Protocol::WebSocket::Frame->new(
            buffer => $test_case->{buffer},
            opcode => $test_case->{opcode},
            masked => 1
        );
        my $frame_bytestring = $f->to_bytes;
        my @frame_bytes = unpack("C*", $frame_bytestring);
        ok $frame_bytes[1] & 0x80, "$test_case->{label}: MASK bit is set";
            
        my $p = Protocol::WebSocket::Frame->new();
        $p->append($frame_bytestring);
        my $message = $p->next_bytes;
        is $message   => $test_case->{buffer}, "$test_case->{label}: parse buffer OK";
        is $p->opcode => $test_case->{opcode}, "$test_case->{label}: parse opcode OK";
    }
};

subtest 'append is destructive' => sub {
    my $f = Protocol::WebSocket::Frame->new();

    my $chunk = pack('H*', "810548656c6c6f");
    $f->append($chunk);

    is $chunk => "", "append() is destructive";
};

done_testing;