The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

=head1 NAME
Dancer2::Plugin::Auth::Extensible::Test::App - Dancer2 app for testing providers
=cut
our $VERSION = '0.711';
use strict;
use Test::Deep qw(bag cmp_deeply);
use Dancer2 appname => 'TestApp';
use Scalar::Util qw(blessed);
use YAML ();
set session => 'simple';
set logger => 'capture';
set log => 'debug';
set show_errors => 1;
# nasty shared global makes it easy to pass data between app and test script
our $data = {};
config->{plugins}->{"Auth::Extensible"}->{password_reset_send_email} =
__PACKAGE__ . "::email_send";
config->{plugins}->{"Auth::Extensible"}->{welcome_send} =
__PACKAGE__ . "::email_send";
sub email_send {
my ( $plugin, %args ) = @_;
$data = { %args, called => 1 };
}
# we need the plugin object and a provider for provider tests
my $plugin = app->with_plugin('Auth::Extensible');
my $provider = $plugin->auth_provider('config1');
my @provider_can = ();
push @provider_can, 'record_lastlogin' if $plugin->config->{record_lastlogin};
config->{plugins}->{"Auth::Extensible"}->{reset_password_handler} = 1
if $provider->can('get_user_by_code');
#
# IMPORTANT NOTE
#
# We use "isnt exception {...}, undef, ..." a lot which is REALLY BAD
# practice. This should only ever be done in provider tests since we cannot
# be sure what exception message a provider returns and we do NOT mandate
# specific messages so we can only test if something died.
#
# When writing new provider tests please always test first with a "like /qr/"
# instead and then once the tests are all working against one provider switch
# them to the bad "isnt undef" style so they are portable.
#
subtest 'Provider authenticate_user tests' => sub {
my $ret;
push @provider_can, 'authenticate_user';
isnt exception { $ret = $provider->authenticate_user(); },
undef,
"authenticate_user with no args dies.";
isnt exception { $ret = $provider->authenticate_user(''); },
undef,
"authenticate_user with empty username and no password dies.";
isnt exception { $ret = $provider->authenticate_user(undef, ''); },
undef,
"authenticate_user with undef username and empty password dies.";
is exception { $ret = $provider->authenticate_user('', ''); },
undef,
"authenticate_user with empty username and empty password lives.";
ok !$ret, "... and returns a false value.";
is exception { $ret = $provider->authenticate_user('unknown', 'beer'); },
undef,
"authenticate_user with unknown user lives.";
ok !$ret, "... and returns a false value.";
is exception { $ret = $provider->authenticate_user('dave', 'notcorrect'); },
undef,
"authenticate_user with known user and bad password lives.";
ok !$ret, "... and returns a false value.";
is exception { $ret = $provider->authenticate_user('dave', 'beer'); },
undef,
"authenticate_user with known user and good password.";
ok $ret, "... and returns a true value.";
};
SKIP: {
skip "Provider has no get_user_details method", 1
unless $provider->can('get_user_details');
subtest 'Provider get_user_details tests' => sub {
my $ret;
push @provider_can, 'get_user_details';
isnt exception { $ret = $provider->get_user_details(); },
undef,
"get_user_details with no args dies.";
is exception { $ret = $provider->get_user_details(''); },
undef,
"get_user_details with empty username lives.";
ok !$ret, "... and returns a false value.";
is exception { $ret = $provider->get_user_details('unknown'); },
undef,
"get_user_details with unknown user lives.";
ok !$ret, "... and returns a false value.";
is exception { $ret = $provider->get_user_details('dave'); },
undef,
"get_user_details with known user lives.";
ok $ret, "... and returns a true value";
ok blessed($ret) || ref($ret) eq 'HASH',
"... which is either an object or a hash reference"
or diag explain $ret;
is blessed($ret) ? $ret->name : $ret->{name}, 'David Precious',
"... and user's name is David Precious.";
};
}
SKIP: {
skip "Provider has no get_user_roles method", 1
unless $provider->can('get_user_roles');
subtest 'Provider get_user_roles tests' => sub {
my $ret;
push @provider_can, 'get_user_roles';
isnt exception { $ret = $provider->get_user_roles(); },
undef,
"get_user_roles with no args dies.";
is exception { $ret = $provider->get_user_roles(''); }, undef,
"get_user_roles with empty username lives";
ok !$ret, "... and returns false value.";
is exception { $ret = $provider->get_user_roles('unknown'); }, undef,
"get_user_roles with unknown user lives";
ok !$ret, "... and returns false value.";
is exception { $ret = $provider->get_user_roles('dave'); }, undef,
"get_user_roles with known user \"dave\" lives";
ok $ret, "... and returns true value";
is ref($ret), 'ARRAY', "... which is an array reference";
cmp_deeply $ret, bag( "BeerDrinker", "Motorcyclist" ),
"... and dave is a BeerDrinker and Motorcyclist.";
};
}
SKIP: {
skip "Provider has no create_user method", 1
unless $provider->can('create_user');
subtest 'Provider create_user tests' => sub {
my $ret;
push @provider_can, 'create_user';
isnt exception { $ret = $provider->create_user(); },
undef,
"create_user with no args dies.";
isnt exception { $ret = $provider->create_user(username => ''); },
undef,
"create_user with empty username dies.";
isnt exception { $ret = $provider->create_user(username => 'dave'); },
undef,
"create_user with existing username dies.";
is exception {
$ret = $provider->get_user_details('provider_create_user');
},
undef,
"get_user_details \"provider_create_user\" lives";
ok !defined $ret, "... and does not return a user.";
is exception {
$ret = $provider->create_user(
username => 'provider_create_user',
name => 'Create User'
);
},
undef,
"create_user \"provider_create_user\" lives";
ok defined $ret, "... and returns a user";
is blessed($ret) ? $ret->name : $ret->{name}, "Create User",
"... and user's name is correct.";
is exception {
$ret = $provider->get_user_details('provider_create_user');
},
undef,
"get_user_details \"provider_create_user\" lives";
ok defined $ret, "... and now *does* return a user.";
is blessed($ret) ? $ret->name : $ret->{name}, "Create User",
"... and user's name is correct.";
};
}
SKIP: {
skip "Provider has no set_user_details method", 1
unless $provider->can('set_user_details');
subtest 'Provider set_user_details tests' => sub {
my $ret;
push @provider_can, 'set_user_details';
isnt exception { $ret = $provider->set_user_details(); },
undef,
"set_user_details with no args dies.";
isnt exception { $ret = $provider->set_user_details(''); },
undef,
"set_user_details with empty username dies.";
is exception {
$ret = $provider->create_user(
username => 'provider_set_user_details',
name => 'Initial Name'
);
},
undef,
"Create a user for testing lives";
is exception {
$ret = $provider->get_user_details('provider_set_user_details')
},
undef,
"... and get_user_details on new user lives";
is blessed($ret) ? $ret->name : $ret->{name}, 'Initial Name',
"... and user has expected name.";
is exception {
$ret = $provider->set_user_details( 'provider_set_user_details',
name => 'New Name', );
},
undef,
"Using set_user_details to change user's name lives";
is blessed($ret) ? $ret->name : $ret->{name}, 'New Name',
"... and returned user has expected name.";
is exception {
$ret = $provider->get_user_details('provider_set_user_details')
},
undef,
"... and get_user_details on new user lives";
is blessed($ret) ? $ret->name : $ret->{name}, 'New Name',
"... and returned user has expected name.";
};
}
SKIP: {
skip "Provider has no get_user_by_code method", 1
unless $provider->can('get_user_by_code');
subtest 'Provider get_user_by_code tests' => sub {
my $ret;
push @provider_can, 'get_user_by_code';
isnt exception { $ret = $provider->get_user_by_code(); },
undef,
"get_user_by_code with no args dies.";
isnt exception { $ret = $provider->get_user_by_code(''); },
undef,
"get_user_by_code with empty code dies.";
is exception { $ret = $provider->get_user_by_code('nosuchcode'); },
undef,
"get_user_by_code with non-existant code lives";
ok !defined $ret, "... and returns undef.";
is exception {
$ret = $provider->create_user(
username => 'provider_get_user_by_code',
pw_reset_code => '01234567890get_user_by_code',
);
},
undef,
"Create a user for testing lives";
is exception {
$ret = $provider->get_user_by_code('01234567890get_user_by_code');
},
undef,
"get_user_by_code with non-existant code lives";
ok defined $ret, "... and returns something true";
is $ret, 'provider_get_user_by_code',
"... and returned username is correct.";
};
}
SKIP: {
skip "Provider has no set_user_password method", 1
unless $provider->can('set_user_password');
subtest 'Provider set_user_password tests' => sub {
my $ret;
push @provider_can, 'set_user_password';
isnt exception { $ret = $provider->set_user_password(); },
undef,
"set_user_password with no args dies.";
isnt exception { $ret = $provider->set_user_password(''); },
undef,
"set_user_password with username but undef password dies";
isnt exception { $ret = $provider->set_user_password( undef, '' ); },
undef,
"set_user_password with password but undef username dies";
is exception {
$ret =
$provider->create_user( username => 'provider_set_user_password' )
},
undef,
"Create a user for testing lives";
is exception {
$ret = $provider->set_user_password( 'provider_set_user_password',
'aNicePassword' )
},
undef, "set_user_password for our new user lives";
is exception {
$ret = $provider->authenticate_user( 'provider_set_user_password',
'aNicePassword' )
},
undef, "... and authenticate_user with correct password lives";
ok $ret, "... and authenticate_user passes (returns true)";
is exception {
$ret = $provider->authenticate_user( 'provider_set_user_password',
'badpwd' )
},
undef, "... and whilst authenticate_user with bad password lives";
ok !$ret, "... it returns false.";
};
}
SKIP: {
skip "Provider has no password_expired method", 1
unless $provider->can('password_expired');
subtest 'Provider password_expired tests' => sub {
my $ret;
push @provider_can, 'password_expired';
isnt exception { $ret = $provider->password_expired(); },
undef,
"password_expired with no args dies.";
is exception {
$ret =
$provider->create_user( username => 'provider_password_expired' )
},
undef,
"Create a user for testing lives";
is exception {
$ret = $provider->password_expired($ret)
},
undef,
"... and password_expired for user lives";
ok $ret, "... and password is expired since it has never been set.";
is exception {
$ret = $provider->set_user_password( 'provider_password_expired',
'password' )
},
undef,
"Setting password for user lives";
is exception {
$ret = $provider->password_expired($ret)
},
undef,
"... and password_expired for user lives";
ok !$ret, "... and password is now *not* expired.";
is exception {
$ret = $provider->set_user_details( 'provider_password_expired',
pw_changed => DateTime->now->subtract( weeks => 1 ) )
},
undef,
"Set pw_changed to one week ago lives and so now password is expired";
is exception {
$ret = $provider->password_expired($ret)
},
undef,
"... and password_expired for user lives";
ok $ret, "... and password *is* now expired since expiry is 2 days.";
};
}
subtest "Plugin coverage testing" => sub {
# DO NOT use this for testing things that can be tested elsewhere since
# these tests are purely to catch the code paths that we can't get to
# any other way.
like exception { $plugin->realm() }, qr/realm name not provided/,
"Calling realm method with no args dies";
like exception { $plugin->realm('') }, qr/realm name not provided/,
"... and calling it with single empty arg dies.";
foreach my $username ( undef, +{}, '', 'username' ) {
foreach my $password ( undef, +{}, '', 'password' ) {
my $ret = $plugin->authenticate_user( $username, $password );
is $ret, 0,
"Checking authenticate_user with username/password: "
. mydumper($username) . "/"
. mydumper($password);
}
}
};
sub mydumper {
my $val = shift;
!defined $val && return '(undef)';
ref($val) ne '' && return ref($val);
$val eq '' && return '(empty)';
$val;
};
# hooks
hook before_authenticate_user => sub {
debug "before_authenticate_user", to_json( shift, { canonical => 1 } );
};
hook after_authenticate_user => sub {
debug "after_authenticate_user", to_json( shift, { canonical => 1 } );
};
hook before_create_user => sub {
debug "before_create_user", to_json( shift, { canonical => 1 } );
};
hook after_create_user => sub {
my ( $username, $user, $errors ) = @_;
my $ret = $user ? 1 : 0;
debug "after_create_user,$username,$ret,",scalar @$errors ? 'yes' : 'no';
};
# and finally the routes for the main plugin tests
get '/provider_can' => sub {
send_as YAML => \@provider_can;
};
get '/' => sub {
"Index always accessible";
};
post '/authenticate_user' => sub {
my $params = body_parameters->as_hashref;
my @ret = authenticate_user( $params->{username}, $params->{password},
$params->{realm} );
send_as YAML => \@ret;
};
post '/create_user' => sub {
my $params = body_parameters->as_hashref;
my $user = create_user %$params;
return $user ? 1 : 0;
};
post '/get_user_details' => sub {
my $params = body_parameters->as_hashref;
my $user = get_user_details $params->{username}, $params->{realm};
if ( blessed($user) ) {
if ( $user->isa('DBIx::Class::Row')) {
$user = +{ $user->get_columns };
}
else {
# assume some kind of hash-backed object
$user = \%$user;
}
}
return $user ? send_as YAML => $user : 0;
};
get '/session_data' => sub {
my $session = session->data;
send_as YAML => $session;
};
get '/logged_in_user_lastlogin' => sub {
my $dt = logged_in_user_lastlogin;
if ( ref($dt) eq 'DateTime' ) {
return $dt->ymd;
}
return 'not set';
};
get '/logged_in_user' => sub {
my $user = logged_in_user;
if ( blessed($user) ) {
if ( $user->isa('DBIx::Class::Row')) {
$user = +{ $user->get_columns };
}
else {
# assume some kind of hash-backed object
$user = \%$user;
}
}
send_as YAML => $user ? $user : 'none';
};
get '/logged_in_user_twice' => sub {
logged_in_user; # retrieve
my $user = logged_in_user; # should now be stashed in var
if ( blessed($user) ) {
if ( $user->isa('DBIx::Class::Row')) {
$user = +{ $user->get_columns };
}
else {
# assume some kind of hash-backed object
$user = \%$user;
}
}
send_as YAML => $user ? $user : 'none';
};
get '/loggedin' => require_login sub {
"You are logged in";
};
get qr{/regex/(.+)} => require_login sub {
return "Matched";
};
get '/require_login_no_sub' => require_login;
get '/require_login_not_coderef' => require_login { a => 1 };
get '/roles' => require_login sub {
my $roles = user_roles() || [];
return join ',', sort @$roles;
};
get '/roles/:user' => require_login sub {
my $user = param 'user';
return join ',', sort @{ user_roles($user) };
};
get '/roles/:user/:realm' => require_login sub {
my $user = param 'user';
my $realm = param 'realm';
return join ',', sort @{ user_roles($user, $realm) };
};
get '/user_roles' => sub {
return join ',', sort @{ user_roles() };
};
get '/beer' => require_role BeerDrinker => sub {
"You can have a beer";
};
get '/piss' => require_role BearGrylls => sub {
"You can drink piss";
};
get '/piss/regex' => require_role qr/beer/i => sub {
"You can drink piss now";
};
get '/anyrole' => require_any_role ['Foo','BeerDrinker'] => sub {
"Matching one of multiple roles works";
};
get '/allroles' => require_all_roles ['BeerDrinker', 'Motorcyclist'] => sub {
"Matching multiple required roles works";
};
get '/not_allroles' => require_all_roles ['BeerDrinker', 'BadRole'] => sub {
"Matching multiple required roles should fail";
};
get '/does_dave_drink_beer' => sub {
return user_has_role('dave', 'BeerDrinker');
};
get '/does_dave_drink_cider' => sub {
return user_has_role('dave', 'CiderDrinker');
};
get '/does_undef_drink_beer' => sub {
return user_has_role(undef, 'BeerDrinker');
};
get '/user_password' => sub {
return user_password params('query');
};
post '/user_password' => sub {
return user_password %{ body_parameters->as_hashref };
};
get '/update_current_user' => sub {
my $user = update_current_user name => "I love cider";
if ( blessed($user) ) {
if ( $user->isa('DBIx::Class::Row')) {
$user = +{ $user->get_columns };
}
else {
# assume some kind of hash-backed object
$user = \%$user;
}
}
YAML::Dump $user;
};
get '/update_user_name/:realm' => sub {
my $realm = param 'realm';
YAML::Dump update_user 'mark', realm => $realm, name => "Wiltshire Apples $realm";
};
post '/update_user' => sub {
my $params = body_parameters->as_hashref;
my $username = delete $params->{username};
send_as YAML => update_user $username, %$params;
};
get '/get_user_mark/:realm' => sub {
my $realm = param 'realm';
content_type 'text/x-yaml';
my $user = get_user_details 'mark', $realm;
if ( blessed($user) ) {
if ( $user->isa('DBIx::Class::Row')) {
$user = +{ $user->get_columns };
}
else {
# assume some kind of hash-backed object
$user = \%$user;
}
}
YAML::Dump $user;
};
post '/auth_provider' => sub {
$plugin->auth_provider( body_parameters->get('realm') );
return;
};
get '/logged_in_user_password_expired' => sub {
my $ret = logged_in_user_password_expired;
return $ret ? 'yes' : 'no';
};
1;