File Coverage

blib/lib/OIDC/Lite/Client/WebServer.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package OIDC::Lite::Client::WebServer;
2 1     1   1373 use strict;
  1         2  
  1         38  
3 1     1   4 use warnings;
  1         9  
  1         28  
4 1     1   831 use parent 'OAuth::Lite2::Client::WebServer';
  1         276  
  1         4  
5             use bytes ();
6              
7             use URI;
8             use Carp ();
9             use Try::Tiny qw(try catch);
10             use LWP::UserAgent;
11             use HTTP::Request;
12             use HTTP::Headers;
13             use Params::Validate qw(HASHREF);
14             use OAuth::Lite2;
15             use OAuth::Lite2::Util qw(build_content);
16             use OIDC::Lite::Client::TokenResponseParser;
17             use OAuth::Lite2::Client::StateResponseParser;
18              
19             =head1 NAME
20              
21             OIDC::Lite::Client::WebServer - OpenID Connect Web Server Profile Client
22              
23             =head1 SYNOPSIS
24              
25             my $client = OIDC::Lite::Client::WebServer->new(
26             id => q{my_client_id},
27             secret => q{my_client_secret},
28             authorize_uri => q{http://example.org/authorize},
29             access_token_uri => q{http://example.org/token},
30             );
31              
32             # redirect user to authorize page.
33             sub start_authorize {
34             my $your_app = shift;
35             my $redirect_url = $client->uri_to_redirect(
36             redirect_uri => q{http://yourapp/callback},
37             scope => q{photo},
38             state => q{optional_state},
39             );
40              
41             $your_app->res->redirect( $redirect_url );
42             }
43              
44             # this method corresponds to the url 'http://yourapp/callback'
45             sub callback {
46             my $your_app = shift;
47              
48             my $code = $your_app->request->param("code");
49              
50             my $access_token = $client->get_access_token(
51             code => $code,
52             redirect_uri => q{http://yourapp/callback},
53             ) or return $your_app->error( $client->errstr );
54              
55             $your_app->store->save( access_token => $access_token->access_token );
56             $your_app->store->save( expires_at => time() + $access_token->expires_in );
57             $your_app->store->save( refresh_token => $access_token->refresh_token );
58             }
59              
60             sub refresh_access_token {
61             my $your_app = shift;
62              
63             my $access_token = $client->refresh_access_token(
64             refresh_token => $refresh_token,
65             ) or return $your_app->error( $client->errstr );
66              
67             $your_app->store->save( access_token => $access_token->access_token );
68             $your_app->store->save( expires_at => time() + $access_token->expires_in );
69             $your_app->store->save( refresh_token => $access_token->refresh_token );
70             }
71              
72              
73             sub access_to_protected_resource {
74             my $your_app = shift;
75              
76             my $access_token = $your_app->store->get("access_token");
77             my $expires_at = $your_app->store->get("expires_at");
78             my $refresh_token = $your_app->store->get("refresh_token");
79              
80             unless ($access_token) {
81             $your_app->start_authorize();
82             return;
83             }
84              
85             if ($expires_at < time()) {
86             $your_app->refresh_access_token();
87             return;
88             }
89              
90             my $req = HTTP::Request->new( GET => q{http://example.org/photo} );
91             $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) );
92             my $agent = LWP::UserAgent->new;
93             my $res = $agent->request($req);
94             ...
95             }
96              
97              
98             =head1 DESCRIPTION
99              
100             Client library for OpenID Connect Web Server Profile.
101              
102             =head1 METHODS
103              
104             =head2 new( %params )
105              
106             =over 4
107              
108             =item id
109              
110             Client ID
111              
112             =item secret
113              
114             Client secret
115              
116             =item authorize_uri
117              
118             authorization page uri on auth-server.
119              
120             =item access_token_uri
121              
122             token endpoint uri on auth-server.
123              
124             =item refresh_token_uri
125              
126             refresh-token endpoint uri on auth-server.
127             if you omit this, access_token_uri is used instead.
128              
129             =item agent
130              
131             user agent. if you omit this, LWP::UserAgent's object is set by default.
132             You can use your custom agent or preset-agents.
133              
134             See also
135              
136             L
137             L
138             L
139              
140             =back
141              
142             =cut
143              
144             sub new {
145              
146             my $class = shift;
147              
148             my %args = Params::Validate::validate(@_, {
149             id => 1,
150             secret => 1,
151             authorize_uri => { optional => 1 },
152             access_token_uri => { optional => 1 },
153             refresh_token_uri => { optional => 1 },
154             agent => { optional => 1 },
155             });
156              
157             my $self = bless {
158             id => undef,
159             secret => undef,
160             authorize_uri => undef,
161             access_token_uri => undef,
162             refresh_token_uri => undef,
163             last_request => undef,
164             last_response => undef,
165             %args,
166             }, $class;
167              
168             unless ($self->{agent}) {
169             $self->{agent} = LWP::UserAgent->new;
170             $self->{agent}->agent(
171             join "/", __PACKAGE__, $OAuth::Lite2::VERSION);
172             }
173              
174             $self->{format} = 'json';
175             $self->{response_parser} = OIDC::Lite::Client::TokenResponseParser->new;
176             $self->{state_response_parser} = OAuth::Lite2::Client::StateResponseParser->new;
177              
178             return $self;
179             }
180              
181             =head2 uri_to_redirect( %params )
182              
183             =cut
184              
185             sub uri_to_redirect {
186             my $self = shift;
187             my %args = Params::Validate::validate(@_, {
188             redirect_uri => 1,
189             state => { optional => 1 },
190             scope => { optional => 1 },
191             uri => { optional => 1 },
192             extra => { optional => 1, type => HASHREF },
193             });
194              
195             unless (exists $args{uri}) {
196             $args{uri} = $self->{authorize_uri};
197             Carp::croak "uri not found" unless $args{uri};
198             }
199              
200             my %params = (
201             response_type => 'code',
202             client_id => $self->{id},
203             redirect_uri => $args{redirect_uri},
204             );
205             $params{state} = $args{state} if $args{state};
206             $params{scope} = $args{scope} if $args{scope};
207              
208             if ($args{extra}) {
209             for my $key ( keys %{$args{extra}} ) {
210             $params{$key} = $args{extra}{$key};
211             }
212             }
213              
214             my $uri = URI->new($args{uri});
215             $uri->query_form(%params);
216             return $uri->as_string;
217             }
218              
219             =head2 get_access_token( %params )
220              
221             execute verification,
222             and returns L object.
223              
224             =over 4
225              
226             =item code
227              
228             Authorization-code that is issued beforehand by server
229              
230             =item redirect_uri
231              
232             The URL that has used for user authorization's callback
233              
234             =back
235              
236             =cut
237              
238             sub get_access_token {
239             my $self = shift;
240              
241             my %args = Params::Validate::validate(@_, {
242             code => 1,
243             redirect_uri => { optional => 1 },
244             server_state => { optional => 1 },
245             uri => { optional => 1 },
246             use_basic_schema => { optional => 1 },
247             });
248              
249             unless (exists $args{uri}) {
250             $args{uri} = $self->{access_token_uri};
251             Carp::croak "uri not found" unless $args{uri};
252             }
253              
254             my %params = (
255             grant_type => 'authorization_code',
256             code => $args{code},
257             );
258             $params{redirect_uri} = $args{redirect_uri} if $args{redirect_uri};
259             $params{server_state} = $args{server_state} if $args{server_state};
260              
261             unless ($args{use_basic_schema}){
262             $params{client_id} = $self->{id};
263             $params{client_secret} = $self->{secret};
264             }
265              
266             my $content = build_content(\%params);
267             my $headers = HTTP::Headers->new;
268             $headers->header("Content-Type" => q{application/x-www-form-urlencoded});
269             $headers->header("Content-Length" => bytes::length($content));
270             $headers->authorization_basic($self->{id}, $self->{secret})
271             if($args{use_basic_schema});
272             my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content );
273              
274             my $res = $self->{agent}->request($req);
275             $self->{last_request} = $req;
276             $self->{last_response} = $res;
277              
278             my ($token, $errmsg);
279             try {
280             $token = $self->{response_parser}->parse($res);
281             } catch {
282             $errmsg = "$_";
283             return $self->error($errmsg);
284             };
285             return $token;
286             }
287              
288             =head2 refresh_access_token( %params )
289              
290             Refresh access token by refresh_token,
291             returns L object.
292              
293             =over 4
294              
295             =item refresh_token
296              
297             =back
298              
299             =cut
300              
301             sub refresh_access_token {
302             my $self = shift;
303              
304             my %args = Params::Validate::validate(@_, {
305             refresh_token => 1,
306             uri => { optional => 1 },
307             use_basic_schema => { optional => 1 },
308             });
309              
310             unless (exists $args{uri}) {
311             $args{uri} = $self->{access_token_uri};
312             Carp::croak "uri not found" unless $args{uri};
313             }
314              
315             my %params = (
316             grant_type => 'refresh_token',
317             refresh_token => $args{refresh_token},
318             );
319              
320             unless ($args{use_basic_schema}){
321             $params{client_id} = $self->{id};
322             $params{client_secret} = $self->{secret};
323             }
324              
325             my $content = build_content(\%params);
326             my $headers = HTTP::Headers->new;
327             $headers->header("Content-Type" => q{application/x-www-form-urlencoded});
328             $headers->header("Content-Length" => bytes::length($content));
329             $headers->authorization_basic($self->{id}, $self->{secret})
330             if($args{use_basic_schema});
331             my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content );
332              
333             my $res = $self->{agent}->request($req);
334             $self->{last_request} = $req;
335             $self->{last_response} = $res;
336              
337             my ($token, $errmsg);
338             try {
339             $token = $self->{response_parser}->parse($res);
340             } catch {
341             $errmsg = "$_";
342             return $self->error($errmsg);
343             };
344             return $token;
345             }
346              
347             =head2 last_request
348              
349             Returns a HTTP::Request object that is used
350             when you obtain or refresh access token last time internally.
351              
352             =head2 last_request
353              
354             Returns a HTTP::Response object that is used
355             when you obtain or refresh access token last time internally.
356              
357             =cut
358              
359             sub last_request { $_[0]->{last_request} }
360             sub last_response { $_[0]->{last_response} }
361              
362             =head1 AUTHOR
363              
364             Ryo Ito, Eritou.06@gmail.comE
365              
366             =head1 COPYRIGHT AND LICENSE
367              
368             Copyright (C) 2012 by Ryo Ito
369              
370             This library is free software; you can redistribute it and/or modify
371             it under the same terms as Perl itself, either Perl version 5.8.8 or,
372             at your option, any later version of Perl 5 you may have available.
373              
374             =cut
375              
376             1;