CPAN::Groonga

use strict;
use warnings;
use Test::More;
use File::Spec;
use Plack::Test;
use HTTP::Request::Common;
use HTTP::Cookies;

{
    package
        Dancer2::Session::SimpleHexId;
    use Moo;
    extends 'Dancer2::Session::Simple';

    # Subclass that only generates and accepts 8 character hex session id's

    our $valid_session_ids = 0;

    sub generate_id {
        return join "", map { sprintf("%x", rand 16) } 1..8
    }

    sub validate_id {
        my $ok = ( $_[1] =~ m/^[0-9a-f]{8}$/ );
        $valid_session_ids++ if $ok; # this should never increment in these tests
        return $ok;
    }
}

{

    package App;
    use Dancer2;

    set engines => {
        session => {
            Simple      => {cookie_name => 'dancer2.test'},
            SimpleHexId => {cookie_name => 'dancer2.test'},
            YAML        => {cookie_name => 'dancer2.test'}
        }
    };

    set session     => 'Simple';
    set show_stacktrace => 1;

    get '/set_session/*' => sub {
        my ($name) = splat;
        session name => $name;
    };
}

my $url  = 'http://localhost';
my $test = Plack::Test->create(App->to_app);
my $app  = Dancer2->runner->apps->[0];

my $bad_session_id = 'abcdefghijklmnopqrstuvwxyz123456';

for my $engine (qw(YAML Simple SimpleHexId)) {

    # clear current session engine, and rebuild for the test
    # This is *really* messy, playing in object hashrefs..
    delete $app->{session_engine};
    $app->config->{session} = $engine;
    my $session_engine = $app->session_engine;    # trigger a build

    if ($session_engine->can('session_dir')) {
        # make sure our test file does not exist
        my $bad_session_file =
          File::Spec->catfile($session_engine->session_dir,
            $bad_session_id . $session_engine->_suffix);
        unlink $bad_session_file;
    }

    # run the tests for this engine

    my $jar = HTTP::Cookies->new;

    my @cookie;

    subtest "[$engine] set_session and extract cookie" => sub {
        my $res = $test->request(GET "$url/set_session/larry");
        ok($res->is_success, "set_session");

        $jar->extract_cookies($res);
        ok($jar->as_string, 'Cookie set');

        $jar->scan(sub { @cookie = @_ });
    };

    subtest "[$engine] set_session with bad cookie value" => sub {

        # set session cookie value to something bad
        $cookie[2] = $bad_session_id;
        ok($jar->set_cookie(@cookie), "Set bad cookie value");

        my $req = GET "$url/set_session/larry";
        $jar->add_cookie_header($req);
        my $res = $test->request($req);
        ok $res->is_success, "/read_session";

        $jar->clear;
        ok(!$jar->as_string, 'Jar cleared');

        $jar->extract_cookies($res);
        ok($jar->as_string, 'session cookie set again');

        my $sid;
        $jar->scan(sub { $sid = $_[2] });
        isnt $sid, 'abcdefghijklmnopqrstuvwxyz123456',
          "Session ID has been reset";
    };
}

subtest "[SimpleHexId] valid session id count" => sub {
    is $Dancer2::Session::SimpleHexId::valid_session_ids, 0,
        "No valid session keys passed during test"
};

done_testing;