File Coverage

blib/lib/Azure/AD/DeviceLogin.pm
Criterion Covered Total %
statement 15 46 32.6
branch 0 10 0.0
condition 0 3 0.0
subroutine 5 11 45.4
pod 1 3 33.3
total 21 73 28.7


line stmt bran cond sub pod time code
1             package Azure::AD::DeviceLogin;
2 1     1   1349 use Moo;
  1         3  
  1         5  
3 1     1   363 use Azure::AD::Errors;
  1         2  
  1         46  
4 1     1   7 use Types::Standard qw/Str Int InstanceOf CodeRef/;
  1         2  
  1         11  
5 1     1   1026 use JSON::MaybeXS;
  1         2  
  1         63  
6 1     1   6 use HTTP::Tiny;
  1         2  
  1         934  
7              
8             our $VERSION = '0.01';
9              
10             has ua_agent => (is => 'ro', isa => Str, default => sub {
11             'Azure::AD::DeviceLogin ' . $Azure::AD::DeviceLogin::VERSION
12             });
13              
14             has ua => (is => 'rw', required => 1, lazy => 1,
15             default => sub {
16             my $self = shift;
17             HTTP::Tiny->new(
18             agent => $self->ua_agent,
19             timeout => 60,
20             );
21             }
22             );
23              
24             has resource_id => (
25             is => 'ro',
26             isa => Str,
27             required => 1,
28             );
29              
30             has message_handler => (
31             is => 'ro',
32             isa => CodeRef,
33             required => 1,
34             );
35              
36             has tenant_id => (
37             is => 'ro',
38             isa => Str,
39             required => 1,
40             default => sub {
41             $ENV{AZURE_TENANT_ID}
42             }
43             );
44              
45             has client_id => (
46             is => 'ro',
47             isa => Str,
48             required => 1,
49             default => sub {
50             $ENV{AZURE_CLIENT_ID}
51             }
52             );
53              
54             has ad_url => (
55             is => 'ro',
56             isa => Str,
57             default => sub {
58             'https://login.microsoftonline.com'
59             },
60             );
61              
62             has device_endpoint => (
63             is => 'ro',
64             isa => Str,
65             lazy => 1,
66             default => sub {
67             my $self = shift;
68             sprintf '%s/%s/oauth2/devicecode', $self->ad_url, $self->tenant_id;
69             }
70             );
71              
72             has token_endpoint => (
73             is => 'ro',
74             isa => Str,
75             lazy => 1,
76             default => sub {
77             my $self = shift;
78             sprintf "%s/%s/oauth2/token", $self->ad_url, $self->tenant_id;
79             }
80             );
81              
82             sub access_token {
83 0     0 1   my $self = shift;
84 0           $self->_refresh;
85 0           $self->current_creds->{ access_token };
86             }
87              
88             has current_creds => (is => 'rw');
89              
90             has expiration => (
91             is => 'rw',
92             isa => Int,
93             lazy => 1,
94             default => sub { 0 }
95             );
96              
97             sub _refresh_from_cache {
98 0     0     my $self = shift;
99             #TODO: implement caching strategy
100 0           return undef;
101             }
102              
103             sub _save_to_cache {
104 0     0     my $self = shift;
105             #TODO: implement caching strategy
106             }
107              
108             sub get_device_payload {
109 0     0 0   my $self = shift;
110 0           my $device_response = $self->ua->post_form(
111             $self->device_endpoint,
112             {
113             client_id => $self->client_id,
114             resource => $self->resource_id,
115             }
116             );
117              
118 0 0         if (not $device_response->{ success }) {
119             Azure::AD::RemoteError->throw(
120             message => $device_response->{ content },
121             code => 'GetDeviceCodeFailed',
122             status => $device_response->{ status }
123 0           );
124             }
125              
126 0           return decode_json($device_response->{ content });
127             }
128              
129             sub get_auth_payload_for {
130 0     0 0   my ($self, $device_payload) = @_;
131              
132 0           my $code_expiration = time + $device_payload->{ expires_in };
133 0           my $auth_response;
134 0   0       while ($code_expiration > time and not $auth_response->{ success }) {
135 0           sleep($device_payload->{ interval });
136              
137             $auth_response = $self->ua->post_form(
138             $self->token_endpoint,
139             {
140             grant_type => 'device_code',
141             code => $device_payload->{ device_code },
142 0           client_id => $self->client_id,
143             resource => $self->resource_id,
144             }
145             );
146             }
147            
148 0 0         if (not $auth_response->{ success }) {
149             Azure::AD::RemoteError->throw(
150             message => $auth_response->{ content },
151             code => 'GetAuthTokenFailed',
152             status => $auth_response->{ status }
153 0           );
154             }
155              
156 0           return decode_json($auth_response->{content});
157             }
158              
159             sub _refresh {
160 0     0     my $self = shift;
161              
162 0 0         if (not defined $self->current_creds) {
163 0           $self->_refresh_from_cache;
164 0 0         return $self->current_creds if (defined $self->current_creds);
165             }
166              
167 0 0         return if $self->expiration >= time;
168              
169 0           my $device_payload = $self->get_device_payload;
170              
171 0           $self->message_handler->($device_payload->{ message });
172              
173 0           my $auth = $self->get_auth_payload_for($device_payload);
174              
175 0           $self->current_creds($auth);
176 0           $self->expiration($auth->{ expires_on });
177 0           $self->_save_to_cache;
178             }
179              
180             1;
181              
182             =encoding UTF-8
183              
184             =head1 NAME
185              
186             Azure::AD::DeviceLogin - Azure AD Device Login authentication flow
187              
188             =head1 SYNOPSIS
189              
190             use Azure::AD::DeviceLogin;
191             my $creds = Azure::AD::ClientCredentials->new(
192             resource_id => 'https://management.core.windows.net/',
193             message_handler => sub { say $_[0] },
194             client_id => '',
195             tenant_id => '',
196             );
197             say $creds->access_token;
198              
199             =head1 DESCRIPTION
200              
201             Implements the Azure AD Device Login flow. See L for more
202             information and alternative flows.
203              
204             =head1 ATTRIBUTES
205              
206             =head2 resource_id
207              
208             The URL for which you want a token extended (the URL of the service which you want
209             to obtain a token for).
210              
211             C for using the MS Graph API
212              
213             C for using the Azure Management APIs
214              
215             =head2 message_handler
216              
217             Callback that receives the message for the user as it's first argument. This callback
218             should transmit the message to the end user, who has to follow the instructions embedded
219             in it.
220              
221             =head2 tenant_id
222              
223             The ID of the Azure Active Directory Tenant
224              
225             =head2 client_id
226              
227             The Client ID (also referred to as the Application ID) of an application
228              
229             =head2 ad_url
230              
231             This defaults to C, and generally doesn't need to
232             be specified. Azure AD has more endpoints for some clouds:
233              
234             C China Cloud
235              
236             C US Gov Cloud
237              
238             C German Cloud
239              
240             =head1 METHODS
241              
242             =head2 access_token
243              
244             Returns the access token that has to be sent to the APIs you want to access. This
245             is normally sent in the Authentication header of HTTPS requests as a Bearer token.
246              
247             The call to access_token will start the Device Login flow, which involves transmitting
248             a message to the user (see message_handler attribute). The user will have to visit a
249             URL with a browser, insert the code in the message, authorize the application, and then
250             the authentication will proceed. Meanwhile the call to access_code will be blocked,
251             awaiting the user to complete the flow. Once the user completes the instructions the access_code
252             will be returned.
253              
254             The access_token is cached in the object as long as it's valid, so subsequent calls
255             to access_token will return the appropiate token without reauthenticating to Azure AD.
256             If the token has expired, access_token will call Azure AD to obtain a new token.
257              
258             Example usage:
259              
260             my $auth = Azure::AD::DeviceLogin->new(...);
261              
262             use HTTP::Tiny;
263             my $ua = HTTP::Tiny->new;
264             my $response = $ua->get(
265             'http://aservice.com/orders/list',
266             {
267             headers => { Authorization => 'Bearer ' . $auth->access_token }
268             }
269             );
270              
271             =head1 SEE ALSO
272              
273             L
274              
275             =head1 COPYRIGHT and LICENSE
276              
277             Copyright (c) 2018 by CAPSiDE
278             This code is distributed under the Apache 2 License. The full text of the
279             license can be found in the LICENSE file included with this module.
280              
281             =cut