The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use File::Spec;
use Plack::Test;
use HTTP::Request::Common;
use HTTP::Cookies;

{

    package App;
    use Dancer2;

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

    set session     => 'Simple';
    set show_errors => 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)) {

    # 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";
    };
}

done_testing;