File Coverage

blib/lib/CatalystX/OAuth2/Request/GrantAuth.pm
Criterion Covered Total %
statement 27 27 100.0
branch 9 12 75.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 42 46 91.3


line stmt bran cond sub pod time code
1             package CatalystX::OAuth2::Request::GrantAuth;
2 8     8   63 use Moose;
  8         22  
  8         71  
3 8     8   63125 use Moose::Util::TypeConstraints;
  8         24  
  8         98  
4 8     8   19653 use MooseX::SetOnce;
  8         23  
  8         204  
5 8     8   43 use URI;
  8         22  
  8         3354  
6              
7             # ABSTRACT: A catalyst request extension for approving grants
8              
9             with 'CatalystX::OAuth2::Grant';
10              
11             has user => (
12             isa => duck_type(['id']),
13             is => 'rw',
14             traits => ['SetOnce']
15             );
16             has user_is_valid => ( isa => 'Bool', is => 'rw', default => 0 );
17             has approved => (
18             isa => 'Bool',
19             is => 'rw',
20             default => 0,
21             lazy => 1,
22             predicate => 'has_approval'
23             );
24             has code => ( is => 'ro', required => 1 );
25             has granted_scopes =>
26             ( isa => 'ArrayRef', is => 'rw', default => sub { [] } );
27              
28             around _params => sub {
29             my $super = shift;
30             my ($self) = @_;
31             return ( $super->(@_), qw(code granted_scopes code approved) );
32             };
33              
34             sub _build_query_parameters {
35 5     5   18 my ($self) = @_;
36              
37 5 100       203 my %q = $self->has_state ? ( state => $self->state ) : ();
38              
39 5 50       177 $self->response_type eq 'code'
40             or return {
41             error => 'unsuported_response_type',
42             error_description => 'this server does not support "'
43             . $self->response_type
44             . "' as a method for obtaining an authorization code",
45             %q
46             };
47              
48 5         174 my $store = $self->store;
49 5 50       217 my $client = $store->find_client( $self->client_id )
50             or return {
51             error => 'unauthorized_client',
52             error_description => 'the client identified by '
53             . $self->client_id
54             . ' is not authorized to access this resource'
55             };
56              
57 5 100       18915 my $code = $store->find_client_code( $self->code, $self->client_id )
58             or return {
59             error => 'server_error',
60             error_description =>
61             'the server encountered an unexpected error condition'
62             };
63              
64 3 50       20702 if ( $self->has_approval ) {
65             return {
66 3 100       115 error => 'access_denied',
67             error_description => 'the resource owner denied the request'
68             }
69             unless $self->approved;
70 2         42 $code->activate;
71 2         6021 $q{code} = $code->as_string;
72             }
73              
74 2         53 return \%q;
75             }
76              
77             sub next_action_uri {
78 11     11 0 649 my ( $self, $controller, $c ) = @_;
79 11         60 my $uri = URI->new( $c->req->oauth2->redirect_uri );
80 11         1560 $uri->query_form( $self->query_parameters );
81 11         1623 return $uri;
82             }
83              
84             1;
85              
86             __END__
87              
88             =pod
89              
90             =head1 NAME
91              
92             CatalystX::OAuth2::Request::GrantAuth - A catalyst request extension for approving grants
93              
94             =head1 VERSION
95              
96             version 0.001007
97              
98             =head1 AUTHOR
99              
100             Eden Cardim <edencardim@gmail.com>
101              
102             =head1 COPYRIGHT AND LICENSE
103              
104             This software is copyright (c) 2017 by Suretec Systems Ltd.
105              
106             This is free software; you can redistribute it and/or modify it under
107             the same terms as the Perl 5 programming language system itself.
108              
109             =cut