From: Mark Ellis <mark.ellis@cartridgesave.co.uk>
Date: Mon, 17 Mar 2014 14:17:46 +0000 (+0000)
Subject: added role self_check and self_check_any to User store
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Frole_self_check;p=catagits%2FCatalyst-Authentication-Store-DBIx-Class.git

added role self_check and self_check_any to User store

The code to do this was already there, just missing a few
parts on the C::A::S::D::C::User class

also removed unnecessary checks for DBIx::Class from tests as it's a
Makefile.PL requirement
---

diff --git a/Changes b/Changes
index c8babb3..cc1bed5 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Catalyst-Plugin-Authentication-Store-DBIx-Class
 
+       * Added support for self checking roles
        * Fix doc bugs. RT#87372
        * Fix calling User->can() as a class method. RT#90715
 
diff --git a/lib/Catalyst/Authentication/Store/DBIx/Class.pm b/lib/Catalyst/Authentication/Store/DBIx/Class.pm
index 1262d71..6b68e89 100644
--- a/lib/Catalyst/Authentication/Store/DBIx/Class.pm
+++ b/lib/Catalyst/Authentication/Store/DBIx/Class.pm
@@ -114,6 +114,8 @@ This documentation refers to version 0.1503.
                     user_model => 'MyApp::User',
                     role_relation => 'roles',
                     role_field => 'rolename',
+                    check_roles   => 'check_roles',
+                    check_roles_any => 'check_roles_any',
                 }
             }
         }
@@ -167,6 +169,8 @@ The DBIx::Class storage module has several configuration options
                     role_field => 'rolename',
                     ignore_fields_in_find => [ 'remote_name' ],
                     use_userdata_from_session => 1,
+                    check_roles   => 'check_roles',
+                    check_roles_any => 'check_roles_any',
                 }
             }
         }
@@ -259,6 +263,67 @@ has no bearing whatsoever in the initial authentication process.  Note also
 that if use_userdata_from_session is enabled, this config parameter
 is not used at all.
 
+=item check_roles
+
+If this option of set, checking the user has all the roles will be delegated to the
+specified method on the user row. This allows for you to override the role
+check, if you want to check virtual roles, or make super roles etc.
+
+You should set the value to the name of the method on the user row to call
+
+    __PACKAGE__->config('Plugin::Authentication' => {
+        realms => {
+            members => {
+                store => {
+                    check_roles   => 'custom_check_roles',
+                    check_roles_any => 'custom_check_roles_any',
+                }
+            }
+        }
+    });
+
+
+\@roles, and \@wanted_roles will be passed, where \@roles is the list of user roles
+and \@wanted_roles is the list of wanted roles.
+
+Should return true if user has the role.
+
+You will have to check the whole set yourself, eg this is the default behaviour
+when not setting 'check_roles'
+
+    use Set::Object;
+
+    sub custom_check_roles {
+        my ( $self, $roles, $wanted_roles ) = @_;
+
+        my $have = Set::Object->new(@$roles);
+        my $need = Set::Object->new(@$wanted_roles);
+
+        if ( $have->superset($need) ) {
+            return 1;
+        }
+    }
+
+=item check_roles_any
+
+Same as check_roles, except it's for checking that the user has at least one of
+the roles
+
+This is the default when check_roles_any is not set
+
+    use Set::Object;
+
+    sub custom_check_roles_any {
+        my ( $self, $roles, $wanted_roles ) = @_;
+
+        my $have = Set::Object->new(@$roles);
+        my $need = Set::Object->new(@$wanted_roles);
+
+        if ( $have->intersection($need)->size > 0 ) {
+            return 1;
+        }
+    }
+
 =back
 
 =head1 USAGE
diff --git a/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm b/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm
index 18282a4..675e537 100644
--- a/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm
+++ b/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm
@@ -116,10 +116,32 @@ sub supported_features {
 
     return {
         session         => 1,
-        roles           => 1,
+        roles           => {
+            self_check      => $self->config->{check_roles} || 0,,
+            self_check_any  => $self->config->{check_roles_any} || 0,
+        },
     };
 }
 
+#will only be used if $config->{check_roles} is set
+sub check_roles {
+    my ( $self, @wanted_roles ) = @_;
+
+    my @roles = $self->roles;
+    my $name = $self->config->{check_roles};
+
+    return $self->_user->$name( \@roles, \@wanted_roles );
+}
+
+#will only be used if $config->{check_roles_any} is set
+sub check_roles_any {
+    my ( $self, @wanted_roles ) = @_;
+
+    my @roles = $self->roles;
+    my $name = $self->config->{check_roles_any};
+
+    return $self->_user->$name( \@roles, \@wanted_roles );
+}
 
 sub roles {
     my ( $self ) = shift;
@@ -394,6 +416,20 @@ Delegates method calls to the underlying user row.
 
 Delegates handling of the C<< can >> method to the underlying user row.
 
+=head2 check_roles
+
+Calls the specified check_roles method on the underlying user row.
+
+Passes \@roles, \@wanted_roles, where @roles is the list of roles,
+and @wanted_roles is the list of wanted roles
+
+=head2 check_roles_any
+
+Calls the specified check_roles_any method on the underlying user row.
+
+Passes \@roles, \@wanted_roles, where @roles is the list of roles,
+and @wanted_roles is the list of wanted roles
+
 =head1 BUGS AND LIMITATIONS
 
 None known currently, please email the author if you find any.
diff --git a/t/03-authtest.t b/t/03-authtest.t
index 0ecdc8f..bd0a149 100644
--- a/t/03-authtest.t
+++ b/t/03-authtest.t
@@ -13,10 +13,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     plan tests => 19;
 
     use TestApp;
diff --git a/t/04-authsessions.t b/t/04-authsessions.t
index 4952ed4..eea0f9e 100644
--- a/t/04-authsessions.t
+++ b/t/04-authsessions.t
@@ -17,10 +17,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Session;
            die unless $Catalyst::Plugin::Session::VERSION >= 0.02 }
         or plan skip_all =>
diff --git a/t/05-auth-roles-relationship.t b/t/05-auth-roles-relationship.t
index 7b5f1c8..2d3ebf7 100644
--- a/t/05-auth-roles-relationship.t
+++ b/t/05-auth-roles-relationship.t
@@ -13,15 +13,11 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Authorization::Roles }
         or plan skip_all =>
         "Catalyst::Plugin::Authorization::Roles is required for this test";
 
-    plan tests => 8;
+    plan tests => 10;
 
     use TestApp;
     TestApp->config( {
@@ -78,3 +74,9 @@ use Catalyst::Test 'TestApp';
     ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' );
     is( $res->content, 'failed', 'user is not an admin and a user' );
 }
+
+# test superuser role override fails (not enabled)
+{
+    ok( my $res = request('http://localhost/user_login?username=mark&password=secret&detach=is_admin'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin' );
+}
diff --git a/t/06-auth-roles-column.t b/t/06-auth-roles-column.t
index a021fca..f03922b 100644
--- a/t/06-auth-roles-column.t
+++ b/t/06-auth-roles-column.t
@@ -13,15 +13,11 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Authorization::Roles }
         or plan skip_all =>
         "Catalyst::Plugin::Authorization::Roles is required for this test";
 
-    plan tests => 8;
+    plan tests => 10;
 
     use TestApp;
     TestApp->config( {
@@ -77,3 +73,9 @@ use Catalyst::Test 'TestApp';
     ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin_user'), 'request ok' );
     is( $res->content, 'failed', 'user is not an admin and a user' );
 }
+
+# test superuser role override fails (not enabled)
+{
+    ok( my $res = request('http://localhost/user_login?username=graeme&password=supersecret&detach=is_admin'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin' );
+}
diff --git a/t/07-authsessions-cached.t b/t/07-authsessions-cached.t
index 2c8b1d3..a8ab01f 100644
--- a/t/07-authsessions-cached.t
+++ b/t/07-authsessions-cached.t
@@ -17,10 +17,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Session;
            die unless $Catalyst::Plugin::Session::VERSION >= 0.02 }
         or plan skip_all =>
diff --git a/t/08-simpledb-auth-roles-relationship.t b/t/08-simpledb-auth-roles-relationship.t
index 25b85e7..2ecb38c 100644
--- a/t/08-simpledb-auth-roles-relationship.t
+++ b/t/08-simpledb-auth-roles-relationship.t
@@ -13,10 +13,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Authorization::Roles }
         or plan skip_all =>
         "Catalyst::Plugin::Authorization::Roles is required for this test";
diff --git a/t/09-simpledb-auth-roles-column.t b/t/09-simpledb-auth-roles-column.t
index b13494f..f31a946 100644
--- a/t/09-simpledb-auth-roles-column.t
+++ b/t/09-simpledb-auth-roles-column.t
@@ -13,10 +13,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Authorization::Roles }
         or plan skip_all =>
         "Catalyst::Plugin::Authorization::Roles is required for this test";
diff --git a/t/11-authsessions-load-app-context.t b/t/11-authsessions-load-app-context.t
index 7cc2e77..911aa7d 100644
--- a/t/11-authsessions-load-app-context.t
+++ b/t/11-authsessions-load-app-context.t
@@ -17,10 +17,6 @@ BEGIN {
         or plan skip_all =>
         "DBD::SQLite is required for this test";
 
-    eval { require DBIx::Class }
-        or plan skip_all =>
-        "DBIx::Class is required for this test";
-
     eval { require Catalyst::Plugin::Session;
            die unless $Catalyst::Plugin::Session::VERSION >= 0.02 }
         or plan skip_all =>
diff --git a/t/12-auth-roles-relationship-self_check.t b/t/12-auth-roles-relationship-self_check.t
new file mode 100644
index 0000000..bc9e54d
--- /dev/null
+++ b/t/12-auth-roles-relationship-self_check.t
@@ -0,0 +1,119 @@
+#!perl
+
+use strict;
+use warnings;
+use DBI;
+use File::Path;
+use FindBin;
+use Test::More;
+use lib "$FindBin::Bin/lib";
+
+BEGIN {
+    eval { require DBD::SQLite }
+        or plan skip_all =>
+        "DBD::SQLite is required for this test";
+
+    eval { require Catalyst::Plugin::Authorization::Roles }
+        or plan skip_all =>
+        "Catalyst::Plugin::Authorization::Roles is required for this test";
+
+    plan tests => 29;
+
+    use TestApp;
+    TestApp->config( {
+        name => 'TestApp',
+        authentication => {
+            default_realm => "users",
+            realms => {
+                users => {
+                    credential => {
+                        'class' => "Password",
+                        'password_field' => 'password',
+                        'password_type' => 'clear'
+                    },
+                    store => {
+                        'class' => 'DBIx::Class',
+                        'user_model' => 'TestApp::User',
+                        'role_relation' => 'roles',
+                        'role_field' => 'role',
+                        'check_roles'   => 't_check_roles',
+                        'check_roles_any' => 't_check_roles_any'
+                    },
+                },
+            },
+        },
+    } );
+
+    TestApp->setup(
+        qw/Authentication
+           Authorization::Roles
+           /
+    );
+}
+
+use Catalyst::Test 'TestApp';
+
+# test user's admin access
+{
+    ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' );
+    is( $res->content, 'ok', 'user is an admin' );
+}
+
+# test unauthorized user's admin access
+{
+    ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin' );
+}
+
+# test multiple auth roles
+{
+    ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is an admin and a user' );
+}
+
+# test multiple unauth roles
+{
+    ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin and a user' );
+}
+
+# test assert_any_user_role
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=nuffin&password=much&detach=is_any_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is user' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'user', 'role is user' );
+}
+
+# test assert_any_user_role
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=jayk&password=letmein&detach=is_any_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is user and an admin' );
+    is ( my @roles = $c->user->roles, 2, '2 roles' );
+    is ( $roles[0], 'admin', 'role is user' );
+    is ( $roles[1], 'user', 'role is admin' );
+}
+
+# test superuser role override
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=mark&password=secret&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
+
+# test superuser role override none existant roles
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=mark&password=secret&detach=is_nonexistant_roles'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
+
+# test superuser role override any none existant roles
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=mark&password=secret&detach=is_any_nonexistant_role'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
diff --git a/t/13-auth-roles-column-self_check.t b/t/13-auth-roles-column-self_check.t
new file mode 100644
index 0000000..8a663b0
--- /dev/null
+++ b/t/13-auth-roles-column-self_check.t
@@ -0,0 +1,118 @@
+#!perl
+
+use strict;
+use warnings;
+use DBI;
+use File::Path;
+use FindBin;
+use Test::More;
+use lib "$FindBin::Bin/lib";
+
+BEGIN {
+    eval { require DBD::SQLite }
+        or plan skip_all =>
+        "DBD::SQLite is required for this test";
+
+    eval { require Catalyst::Plugin::Authorization::Roles }
+        or plan skip_all =>
+        "Catalyst::Plugin::Authorization::Roles is required for this test";
+
+    plan tests => 29;
+
+    use TestApp;
+    TestApp->config( {
+        name => 'TestApp',
+        authentication => {
+            default_realm => "users",
+            realms => {
+                users => {
+                    credential => {
+                        'class' => "Password",
+                        'password_field' => 'password',
+                        'password_type' => 'clear'
+                    },
+                    store => {
+                        'class' => 'DBIx::Class',
+                        'user_model' => 'TestApp::User',
+                        'role_column' => 'role_text',
+                        'check_roles'   => 't_check_roles',
+                        'check_roles_any' => 't_check_roles_any'
+                    },
+                },
+            },
+        },
+    } );
+
+    TestApp->setup(
+        qw/Authentication
+           Authorization::Roles
+           /
+    );
+}
+
+use Catalyst::Test 'TestApp';
+
+# test user's admin access
+{
+    ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin'), 'request ok' );
+    is( $res->content, 'ok', 'user is an admin' );
+}
+
+# test unauthorized user's admin access
+{
+    ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin' );
+}
+
+# test multiple auth roles
+{
+    ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is an admin and a user' );
+}
+
+# test multiple unauth roles
+{
+    ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'failed', 'user is not an admin and a user' );
+}
+
+# test assert_any_user_role
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_any_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is user' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'admin', 'role is admin' );
+}
+
+# test assert_any_user_role
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=nuffin&password=much&detach=is_any_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'user is user and an admin' );
+    is ( my @roles = $c->user->roles, 2, '2 roles' );
+    is ( $roles[0], 'user', 'role is user' );
+    is ( $roles[1], 'admin', 'role is admin' );
+}
+
+# test superuser role override
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=graeme&password=supersecret&detach=is_admin_user'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
+
+# test superuser role override none existant roles
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=graeme&password=supersecret&detach=is_nonexistant_roles'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
+
+# test superuser role override any none existant roles
+{
+    ok( my ( $res, $c )= ctx_request('http://localhost/user_login?username=graeme&password=supersecret&detach=is_any_nonexistant_role'), 'request ok' );
+    is( $res->content, 'ok', 'superuser role is all roles' );
+    is ( my @roles = $c->user->roles, 1, 'only 1 role' );
+    is ( $roles[0], 'superadmin', 'role is user' );
+}
diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm
index 3c1ba32..f2998de 100644
--- a/t/lib/TestApp/Controller/Root.pm
+++ b/t/lib/TestApp/Controller/Root.pm
@@ -202,6 +202,46 @@ sub is_admin_user : Global {
     }
 }
 
+sub is_any_admin_user : Global {
+    my ( $self, $c ) = @_;
+
+    eval {
+        if ( $c->assert_any_user_role( qw/admin user/ ) ) {
+            $c->res->body( 'ok' );
+        }
+    };
+    if ($@) {
+        $c->res->body( 'failed' );
+    }
+}
+
+sub is_nonexistant_roles: Global {
+    my ( $self, $c ) = @_;
+
+    eval {
+        if ( $c->assert_user_roles( qw/madeUProle baconHater/ ) ) {
+            $c->res->body( 'ok' );
+        }
+    };
+    if ($@) {
+        $c->res->body( 'failed' );
+    }
+}
+
+sub is_any_nonexistant_role: Global {
+    my ( $self, $c ) = @_;
+
+    eval {
+        if ( $c->assert_any_user_role( qw/madeUProle baconHater/ ) ) {
+            $c->res->body( 'ok' );
+        }
+    };
+    if ($@) {
+        $c->res->body( 'failed' );
+    }
+}
+
+
 sub set_usersession : Global {
     my ( $self, $c, $value ) = @_;
     $c->user_session->{foo} = $value;
diff --git a/t/lib/TestApp/Model/TestApp.pm b/t/lib/TestApp/Model/TestApp.pm
index 7abe403..3cba547 100644
--- a/t/lib/TestApp/Model/TestApp.pm
+++ b/t/lib/TestApp/Model/TestApp.pm
@@ -27,11 +27,15 @@ my @deployment_statements = split /;/, q{
     INSERT INTO user VALUES (2, 'spammer', 'bob@spamhaus.com', 'broken', 'disabled', NULL, NULL);
     INSERT INTO user VALUES (3, 'jayk', 'j@cpants.org', 'letmein', 'active', NULL, NULL);
     INSERT INTO user VALUES (4, 'nuffin', 'nada@mucho.net', 'much', 'registered', 'user admin', NULL);
+    INSERT INTO user VALUES (5, 'mark', 'b@con.com', 'secret', 'active', NULL, NULL);
+    INSERT INTO user VALUES (6, 'graeme', 'gr@e.me', 'supersecret', 'active', 'superadmin', NULL);
     INSERT INTO role VALUES (1, 'admin');
     INSERT INTO role VALUES (2, 'user');
+    INSERT INTO role VALUES (3, 'superadmin');
     INSERT INTO user_role VALUES (1, 3, 1);
     INSERT INTO user_role VALUES (2, 3, 2);
-    INSERT INTO user_role VALUES (3, 4, 2)
+    INSERT INTO user_role VALUES (3, 4, 2);
+    INSERT INTO user_role VALUES (4, 5, 3)
 };
 
 __PACKAGE__->config(
diff --git a/t/lib/TestApp/Schema/User.pm b/t/lib/TestApp/Schema/User.pm
index 7ad6ef8..7020de9 100644
--- a/t/lib/TestApp/Schema/User.pm
+++ b/t/lib/TestApp/Schema/User.pm
@@ -18,4 +18,36 @@ __PACKAGE__->has_many( 'map_user_role' => 'TestApp::Schema::UserRole' => 'user'
 
 __PACKAGE__->many_to_many( roles => 'map_user_role', 'role');
 
+use Set::Object;
+
+sub t_check_roles {
+    my ( $self, $roles, $wanted_roles ) = @_;
+
+    if ( grep { $_ eq 'superadmin' } @$roles ) {
+        return 1;
+    }
+
+    my $have = Set::Object->new(@$roles);
+    my $need = Set::Object->new(@$wanted_roles);
+
+    if ( $have->superset($need) ) {
+        return 1;
+    }
+}
+
+sub t_check_roles_any {
+    my ( $self, $roles, $wanted_roles ) = @_;
+
+    if ( grep { $_ eq 'superadmin' } @$roles ) {
+        return 1;
+    }
+
+    my $have = Set::Object->new(@$roles);
+    my $need = Set::Object->new(@$wanted_roles);
+
+    if ( $have->intersection($need)->size > 0 ) {
+        return 1;
+    }
+}
+
 1;