File Coverage

blib/lib/Net/Duo/Mock/Agent.pm
Criterion Covered Total %
statement 119 122 97.5
branch 20 24 83.3
condition 6 11 54.5
subroutine 16 16 100.0
pod 3 3 100.0
total 164 176 93.1


line stmt bran cond sub pod time code
1             # Mock LWP::UserAgent for Net::Duo testing.
2             #
3             # This module provides the same interface as LWP::UserAgent, for the methods
4             # that Net::Duo calls, and verifies that the information passed in by Duo is
5             # correct. It can also simulate responses to exercise response handling in
6             # Net::Duo.
7             #
8             # All tests are reported by Test::More, and no effort is made to produce a
9             # predictable number of test results. This means that any calling test
10             # program should probably not specify a plan and instead use done_testing().
11             #
12             # SPDX-License-Identifier: MIT
13              
14             package Net::Duo::Mock::Agent 1.02;
15              
16 10     10   135399 use 5.014;
  10         105  
17 10     10   56 use strict;
  10         20  
  10         217  
18 10     10   48 use warnings;
  10         18  
  10         292  
19              
20 10     10   52 use Carp qw(croak);
  10         18  
  10         804  
21 10     10   4704 use Digest::SHA qw(hmac_sha1_hex);
  10         36770  
  10         806  
22 10     10   5326 use Encode qw(decode);
  10         107016  
  10         757  
23 10     10   4114 use HTTP::Request;
  10         191045  
  10         399  
24 10     10   4194 use HTTP::Response;
  10         61204  
  10         299  
25 10     10   1823 use JSON ();
  10         29227  
  10         270  
26 10     10   4436 use Perl6::Slurp;
  10         15499  
  10         62  
27 10     10   6115 use Test::More;
  10         624158  
  10         102  
28 10     10   2937 use URI::Escape qw(uri_unescape);
  10         27  
  10         11464  
29              
30             ##############################################################################
31             # Mock API
32             ##############################################################################
33              
34             # Verify the signature on the request.
35             #
36             # The signature uses the Basic Authentication Scheme and should use the
37             # integration key as the username and the hash of the call as the password.
38             # This function duplicates the signature and ensures it's correct. All test
39             # results are reported via Test::More functions.
40             #
41             # $self - Net::Duo::Mock::Agent object
42             # $request - HTTP::Request object to verify
43             #
44             # Returns: undef
45             sub _verify_signature {
46 46     46   116 my ($self, $request) = @_;
47 46         207 my $date = $request->header('Date');
48 46         2174 my $method = uc($request->method);
49 46         575 my $host = $self->{api_hostname};
50              
51             # Get the partial URI. We have to strip the scheme and hostname back off
52             # of it again. Verify the scheme and hostname while we're at it.
53 46         137 my $uri = URI->new($request->uri);
54 46         4348 is($uri->scheme, 'https', 'Scheme');
55 46         16374 is($uri->host, $host, 'Hostname');
56 46         15616 my $path = $uri->path;
57              
58             # Get the username and "password" (actually the hash). Verify the
59             # username.
60 46         812 my ($username, $password) = $request->authorization_basic;
61 46         2853 is($username, $self->{integration_key}, 'Username');
62              
63             # If there is request data, sort it for signing purposes.
64 46         14949 my $args;
65 46 100       163 if ($method eq 'GET') {
66 17   100     113 $args = $uri->query // q{};
67             } else {
68 29   50     118 $args = $request->content // q{};
69             }
70 46         995 $args = join(q{&}, sort(split(m{&}xms, $args)));
71              
72             # Generate the hash of the request and check it.
73 46         171 my $data = join("\n", $date, $method, $host, $path, $args);
74 46         433 my $signature = hmac_sha1_hex($data, $self->{secret_key});
75 46         190 is($password, $signature, 'Signature');
76 46         15244 return;
77             }
78              
79             # Given an HTTP::Request, pretend to perform the request and return an
80             # HTTP::Response object. The content of the HTTP::Response object will be
81             # determined by the most recent calls to the testing API. Each request resets
82             # the response. If no response has been configured, throw an exception.
83             #
84             # $self - Net::Duo::Mock::Agent object
85             # $request - HTTP::Request object to verify
86             #
87             # Returns: An HTTP::Response object
88             # Throws: Exception on fatally bad requests or on an unconfigured test
89             sub request {
90 46     46 1 129 my ($self, $request) = @_;
91              
92             # Throw an exception if we got an unexpected call.
93 46 50       77 if (!@{ $self->{expected} }) {
  46         175  
94 0         0 croak('saw an unexpected request');
95             }
96 46         82 my $expected = shift(@{ $self->{expected} });
  46         112  
97              
98             # Verify the signature on the request. We continue even if it doesn't
99             # verify and check the rest of the results.
100 46         179 $self->_verify_signature($request);
101              
102             # Ensure the method and URI match what we expect, and extract the content.
103 46         190 is($request->method, $expected->{method}, 'Method');
104 46         15190 my $uri = $request->uri;
105 46         368 my $content;
106 46 100       123 if ($request->method eq 'GET') {
107 17 100       252 if ($uri =~ s{ [?] (.*) }{}xms) {
108 13         233 $content = $1;
109             } else {
110 4         37 $content = q{};
111             }
112             } else {
113 29   50     400 $content = $request->content // q{};
114             }
115 46         525 is($uri, $expected->{uri}, 'URI');
116              
117             # Decode the content.
118 46   50     15078 my @pairs = split(m{&}xms, $content // q{});
119 46         106 my %content;
120 46         117 for my $pair (@pairs) {
121 77         245 my ($key, $value) = split(m{=}xms, $pair, 2);
122 77         219 $key = decode('UTF-8', uri_unescape($key));
123 77         5890 $value = decode('UTF-8', uri_unescape($value));
124 77         3968 $content{$key} = $value;
125             }
126              
127             # Check the content.
128 46 100       182 if ($expected->{content}) {
129 31         142 is_deeply(\%content, $expected->{content}, 'Content');
130             } else {
131 15         59 is($content, q{}, 'Content');
132             }
133              
134             # Return the configured response.
135 46         23253 my $response = $expected->{response};
136 46         566 return $response;
137             }
138              
139             ##############################################################################
140             # Test API
141             ##############################################################################
142              
143             # Constructor for the mock agent. Takes the same arguments as are passed to
144             # the Net::Duo constructor (minus the user_agent argument) so that the mock
145             # knows the expected keys and hostname.
146             #
147             # $class - Class into which to bless the object
148             # $args_ref - Arguments to the Net::Duo constructor
149             # api_hostname - API hostname for the Duo API integration
150             # integration_key - Public key for the Duo API integration
151             # key_file - Path to file with integration information
152             # secret_key - Secret key for the Duo API integration
153             #
154             # Returns: New Net::Duo::Mock::Agent object
155             # Throws: Text exception on failure to read keys
156             sub new {
157 10     10 1 1115 my ($class, $args_ref) = @_;
158 10         36 my $self = {};
159              
160             # Load integration information from key_file if set.
161 10         24 my $keys;
162 10 50       44 if ($args_ref->{key_file}) {
163 10         129 my $json = JSON->new()->relaxed(1);
164 10         59 my $key_data = slurp($args_ref->{key_file});
165 10         2082 $keys = $json->decode($key_data);
166             }
167              
168             # Integration data from $args_ref overrides key_file data.
169 10         41 for my $key (qw(api_hostname integration_key secret_key)) {
170 30   33     175 $self->{$key} = $args_ref->{$key} // $keys->{$key};
171             }
172              
173             # Create the JSON decoder that we'll use for subsequent operations.
174 10         104 $self->{json} = JSON->new->utf8(1);
175              
176             # Create the queue of expected requests.
177 10         37 $self->{expected} = [];
178              
179             # Bless and return the new object.
180 10         41 bless($self, $class);
181 10         91 return $self;
182             }
183              
184             # Configure an expected request and the response to return. Either response
185             # or response_file should be given. If response_file is given, an
186             # HTTP::Response with a status code of 200 and the contents of that file as
187             # the body (Content-Type: application/json).
188             #
189             # $self - Net::Duo::Mock::Agent object
190             # $args_ref - Expected request and response information
191             # method - Expected method of the request
192             # uri - Expected URI of the request without any query string
193             # content - Expected query or post data as reference (may be undef)
194             # response - HTTP::Response object to return to the caller
195             # response_data - Partial data structure to add to generic JSON in response
196             # response_file - File containing JSON to return as a respose
197             # next_offset - Return paging metadata with this next_offset key
198             # total_objects - Value for the paging metadata if next_offset is given
199             #
200             # Returns: undef
201             # Throws: Text exception on invalid parameters
202             # Text exception if response_file is not readable
203             sub expect {
204 46     46 1 16605 my ($self, $args_ref) = @_;
205              
206             # Verify consistency of the arguments.
207 46         139 my @response_args = qw(response response_data response_file);
208 46         165 my $response_count = grep { defined($args_ref->{$_}) } @response_args;
  138         353  
209 46 50       220 if ($response_count < 1) {
    50          
210 0         0 croak('no response, response_data, or response_file specified');
211             } elsif ($response_count > 1) {
212 0         0 croak('too many of response, response_data, and response_file given');
213             }
214              
215             # Build the response object if needed.
216 46         81 my $response;
217 46 100       117 if ($args_ref->{response}) {
218 1         3 $response = $args_ref->{response};
219             } else {
220 45         314 $response = HTTP::Response->new(200, 'Success');
221 45         2889 $response->header('Content-Type', 'application/json');
222 45         3099 my $reply;
223 45 100       195 if (defined($args_ref->{response_data})) {
224 23         122 my $data = $args_ref->{response_data};
225 23         98 $reply = { stat => 'OK', response => $data };
226             } else {
227 22         93 my $contents = slurp($args_ref->{response_file});
228 22         3914 my $data = $self->{json}->decode($contents);
229 22         97 $reply = { stat => 'OK', response => $data };
230             }
231 45 100       209 if (defined($args_ref->{next_offset})) {
    100          
232             $reply->{metadata} = {
233             next_offset => $args_ref->{next_offset},
234             prev_offset => 0,
235             total_objects => $args_ref->{total_objects},
236 2         10 };
237             } elsif (exists($args_ref->{next_offset})) {
238             $reply->{metadata} = {
239             prev_offset => 0,
240             total_objects => $args_ref->{total_objects},
241 2         9 };
242             }
243 45         624 $response->content($self->{json}->encode($reply));
244             }
245              
246             # Set the expected information for call verification later.
247             my $expected = {
248             method => uc($args_ref->{method}),
249             uri => 'https://' . $self->{api_hostname} . $args_ref->{uri},
250             content => $args_ref->{content},
251 46         1524 response => $response,
252             };
253 46         95 push(@{ $self->{expected} }, $expected);
  46         139  
254 46         144 return;
255             }
256              
257             1;
258             __END__