File Coverage

blib/lib/Authorization/AccessControl/Grant.pm
Criterion Covered Total %
statement 112 114 98.2
branch 36 40 90.0
condition 18 23 78.2
subroutine 19 19 100.0
pod 7 8 87.5
total 192 204 94.1


line stmt bran cond sub pod time code
1             package Authorization::AccessControl::Grant 0.04;
2 7     7   189359 use v5.26;
  7         31  
3 7     7   39 use warnings;
  7         15  
  7         453  
4              
5             # ABSTRACT: Encapsulation of the parameters of a privilege grant
6              
7 7     7   4082 use Data::Compare;
  7         106243  
  7         68  
8 7     7   37219 use Readonly;
  7         36365  
  7         566  
9 7     7   64 use Scalar::Util qw(looks_like_number);
  7         19  
  7         435  
10              
11 7     7   2765 use experimental qw(signatures);
  7         22250  
  7         53  
12              
13             use overload
14 7     7   1469 '""' => 'to_string';
  7         17  
  7         67  
15              
16 62     62 1 284584 sub new($class, %params) {
  62         175  
  62         215  
  62         252  
17 62         131 my $role = delete($params{role});
18 62         121 my $resource = delete($params{resource});
19 62         117 my $action = delete($params{action});
20 62         119 my $restrictions = delete($params{restrictions});
21 62 100       203 $restrictions = {} unless (defined($restrictions));
22              
23 62 100       219 die("Unsupported params: ", join(', ', keys(%params))) if (keys(%params));
24 61 100 66     308 die("Role must be a non-empty string") if (defined($role) && (ref($role) || $role eq ''));
      100        
25 60 100 66     277 die("Resource is required") unless ($resource && !ref($resource));
26 58 100 66     236 die("Action is required") unless ($action && !ref($action));
27 56 50 33     236 die("Restrictions must be a HashRef") unless (defined($restrictions) && ref($restrictions) eq 'HASH');
28              
29 56         356 Readonly::Scalar my $data => {
30             _role => $role,
31             _resource => $resource,
32             _action => $action,
33             _restrictions => $restrictions
34             };
35              
36 56         7653 bless($data, $class);
37             }
38              
39 9     9 0 850 sub to_string($self, @params) {
  9         41  
  9         22  
  9         14  
40 9 100       47 my $role = $self->{_role} ? '[' . $self->{_role} . '] ' : '';
41 9         83 my $restrictions = '';
42 9         29 foreach (keys($self->{_restrictions}->%*)) {
43 3         82 my $v;
44 3 50       13 if ($self->{_restrictions}->{$_}) {$v = $self->{_restrictions}->{$_}}
  3 0       42  
45 0         0 elsif (looks_like_number($self->{_restrictions}->{$_})) {$v = 0}
46 0         0 else {$v = 'false'}
47 3         42 $restrictions .= "$_=$v,";
48             }
49 9         82 chop($restrictions);
50 9         25 $role . $self->{_resource} . ' => ' . $self->{_action} . '(' . $restrictions . ')';
51             }
52              
53 164     164 1 674 sub role($self) {
  164         221  
  164         216  
54 164         531 $self->{_role};
55             }
56              
57 70     70 1 263 sub resource($self) {
  70         98  
  70         110  
58 70         172 $self->{_resource};
59             }
60              
61 54     54 1 193 sub action($self) {
  54         88  
  54         74  
62 54         189 $self->{_action};
63             }
64              
65 18     18 1 67 sub restrictions($self) {
  18         26  
  18         27  
66 18         47 $self->{_restrictions};
67             }
68              
69 24     24   57 sub _satisfies_role($self, @roles) {
  24         37  
  24         42  
  24         66  
70 24 100       105 return 1 unless ($self->{_role});
71 10         123 return (grep {$_ eq $self->{_role}} @roles) > 0;
  6         27  
72             }
73              
74 90     90   111 sub _satisfies_resource($self, $resource) {
  90         117  
  90         115  
  90         107  
75 90 100       191 return 0 unless (defined($resource));
76 89         273 return $self->{_resource} eq $resource;
77             }
78              
79 51     51   67 sub _satisfies_action($self, $action) {
  51         65  
  51         72  
  51         59  
80 51 100       104 return 0 unless (defined($action));
81 50         137 return $self->{_action} eq $action;
82             }
83              
84 18     18   27 sub _satisfies_restrictions($self, $attributes) {
  18         30  
  18         40  
  18         26  
85 18         71 my %attrs = $attributes->%*;
86 18         135 delete($attrs{$_}) foreach (grep {!exists($self->{_restrictions}->{$_})} keys(%attrs));
  16         118  
87 18         218 my $v = Compare($self->{_restrictions}, \%attrs);
88 18         2498 return $v;
89             }
90              
91 82     82 1 181 sub is_equal($self, $priv) {
  82         117  
  82         106  
  82         100  
92 82 100 100     161 return 0 unless (($self->role // '') eq ($priv->role // ''));
      100        
93 35 100       411 return 0 unless ($self->resource eq $priv->resource);
94 27 100       208 return 0 unless ($self->action eq $priv->action);
95 9 100       73 return 0 unless (Compare($self->restrictions, $priv->restrictions));
96 6         685 return 1;
97             }
98              
99 90     90 1 5289 sub accepts($self, %params) {
  90         116  
  90         162  
  90         1072  
100 90         198 my ($roles, $resource, $action, $attributes) = @params{qw(roles resource action attributes)};
101              
102 90 100       160 return 0 unless ($self->_satisfies_resource($resource));
103 51 100       416 return 0 unless ($self->_satisfies_action($action));
104 24 100 100     244 return 0 unless ($self->_satisfies_role(($roles // [])->@*));
105 18 100 100     216 return 0 unless ($self->_satisfies_restrictions($attributes // {}));
106 11         90 return 1;
107             }
108              
109             =head1 NAME
110              
111             Authorization::AccessControl::Grant - Encapsulation of the parameters of a privilege grant
112              
113             =head1 SYNOPSIS
114              
115             use Authorization::AccessControl::Grant;
116              
117             my $grant = Authorization::AccessControl::Grant->new(
118             resource => 'Book',
119             action => 'read',
120             );
121              
122             $grant->accepts(resource => 'Book', action => 'read');
123              
124             =head1 DESCRIPTION
125              
126             This is a simple class to encapsulate the properties of a privilege grant:
127             resource, action, roles, and restrictions, with the latter two optional. Methods
128             are available for checking all properties at once (L) and determining
129             if another grant is exactly equal (used for duplicate detection) (L).
130              
131             Grant instances are immutable: none of their properties may be altered after
132             object creation.
133              
134             =head1 METHODS
135              
136             =head2 new
137              
138             Authorization::AccessControl::Grant->new( %params )
139              
140             Creates a new privilege grant instance. Normally, you should use
141             L rather than this constructor
142             directly, to create and "register" instances. C, C, C,
143             and C keys are respected in C<%params>
144              
145             =head2 role
146              
147             Accessor for the C property
148              
149             =head2 resource
150              
151             Accessor for the C property
152              
153             =head2 action
154              
155             Accessor for the C property
156              
157             =head2 restrictions
158              
159             Accessor for the C property
160              
161             =head2 is_equal
162              
163             $grant1->is_equal($grant2)
164              
165             Returns true if all properties of both grants are exactly the same, false
166             otherwise
167              
168             =head2 accepts
169              
170             $grant->accepts( %params )
171              
172             Returns true if the parameters meet all of the requirements of the grant, false
173             otherwise. Specifically, this means that C and C must match
174             exactly, the grant's C (if set) must be contained within the C
175             ArrayRef, and every item in the grant's C must be matched by a
176             corresponding entry with the same value in the C HashRef
177              
178             =head1 AUTHOR
179              
180             Mark Tyrrell C<< >>
181              
182             =head1 LICENSE
183              
184             Copyright (c) 2024 Mark Tyrrell
185              
186             Permission is hereby granted, free of charge, to any person obtaining a copy
187             of this software and associated documentation files (the "Software"), to deal
188             in the Software without restriction, including without limitation the rights
189             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
190             copies of the Software, and to permit persons to whom the Software is
191             furnished to do so, subject to the following conditions:
192              
193             The above copyright notice and this permission notice shall be included in all
194             copies or substantial portions of the Software.
195              
196             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
197             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
198             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
199             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
200             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
201             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
202             SOFTWARE.
203              
204             =cut
205              
206             1;
207              
208             __END__