view release on metacpan or  search on metacpan

t/plugin_csrf_defender.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;

{
    package TestApp;
    use Ark;

    use_plugins qw/
        Session
        Session::State::Cookie
        Session::Store::Memory
        CSRFDefender
        /;

    conf 'Plugin::Session::State::Cookie' => {
        cookie_expires => '+3d',
    };

    package TestApp::Controller::Root;
    use Ark 'Controller';

    has '+namespace' => default => '';

    sub test_set :Local {
        my ($self, $c) = @_;
        $c->session->set('csrf_token', 'dummy');

        $c->res->content($c->_has_csrf_token ? 'OK' : 'NG');
    }

    sub test_get :Local {
        my ($self, $c) = @_;

        $c->res->body(q{<form action="" method="post"></form>});
    }

    sub test_get_capital :Local {
        my ($self, $c) = @_;

        $c->res->body(q{<form action="" method="POST"></form>});
    }

    sub test_form :Local {
        my ($self, $c) = @_;

        $c->res->body(q{<form></form>});
    }

}

use Ark::Test 'TestApp',
    components       => [qw/Controller::Root/],
    reuse_connection => 1;

subtest 'token_length' => sub {
    my $c = ctx_get '/test_get';
    is length $c->csrf_token, 36;
};

subtest 'token_fix' => sub {
    my $c = ctx_get '/test_set';
    is length $c->csrf_token, 36;
    is $c->res->body, 'OK';

    $c = ctx_get '/test_get';
    is length $c->csrf_token, 5;
};

subtest 'validate_ok' => sub {
    for my $method (qw(GET POST PUT DELETE)) {
        my ($res, $c) = ctx_request($method => '/test_get?csrf_token=dummy');
        is $c->validate_csrf_token, 1;
    }
};