File Coverage

blib/lib/JMAP/Tester.pm
Criterion Covered Total %
statement 251 319 78.6
branch 42 86 48.8
condition 11 27 40.7
subroutine 46 53 86.7
pod 12 17 70.5
total 362 502 72.1


line stmt bran cond sub pod time code
1             package JMAP::Tester 0.109;
2             # ABSTRACT: a JMAP client made for testing JMAP servers
3              
4 3     3   280667 use v5.20.0;
  3         10  
5 3     3   10 use warnings;
  3         9  
  3         194  
6              
7 3     3   1491 use Moo;
  3         22820  
  3         19  
8              
9 3     3   4996 use experimental 'signatures';
  3         4510  
  3         17  
10              
11 3     3   1890 use Crypt::Misc qw(decode_b64u encode_b64u);
  3         31780  
  3         269  
12 3     3   1322 use Crypt::Mac::HMAC qw(hmac_b64u);
  3         3605  
  3         191  
13 3     3   965 use Encode qw(encode_utf8);
  3         30965  
  3         260  
14 3     3   1798 use Future;
  3         37622  
  3         99  
15 3     3   1299 use HTTP::Request;
  3         42024  
  3         108  
16 3     3   1521 use JMAP::Tester::Abort 'abort';
  3         18  
  3         58  
17 3     3   2297 use JMAP::Tester::Logger::Null;
  3         35  
  3         124  
18 3     3   1825 use JMAP::Tester::Response;
  3         15  
  3         127  
19 3     3   1420 use JMAP::Tester::Result::Auth;
  3         13  
  3         125  
20 3     3   1465 use JMAP::Tester::Result::Download;
  3         9  
  3         100  
21 3     3   1551 use JMAP::Tester::Result::Failure;
  3         10  
  3         123  
22 3     3   1542 use JMAP::Tester::Result::Logout;
  3         12  
  3         171  
23 3     3   1525 use JMAP::Tester::Result::Upload;
  3         13  
  3         110  
24 3     3   22 use Module::Runtime ();
  3         5  
  3         74  
25 3     3   14 use Params::Util qw(_HASH0 _ARRAY0);
  3         6  
  3         237  
26 3     3   1625 use Safe::Isa;
  3         1853  
  3         497  
27 3     3   25 use URI;
  3         5  
  3         85  
28 3     3   1341 use URI::QueryParam;
  3         453  
  3         110  
29 3     3   19 use URI::Escape qw(uri_escape);
  3         7  
  3         230  
30              
31 3     3   19 use namespace::clean;
  3         4  
  3         20  
32              
33             #pod =head1 OVERVIEW
34             #pod
35             #pod B This library is in its really early days, so use it with that in
36             #pod mind.
37             #pod
38             #pod JMAP::Tester is for testing JMAP servers. Okay? Okay!
39             #pod
40             #pod JMAP::Tester calls the whole thing you get back from a JMAP server a "response"
41             #pod if it's an HTTP 200. Every JSON Array (of three entries -- go read the spec if
42             #pod you need to!) is called a L. Runs
43             #pod of Sentences with the same client id are called
44             #pod L.
45             #pod
46             #pod You use the test client like this:
47             #pod
48             #pod my $jtest = JMAP::Tester->new({
49             #pod api_uri => 'https://jmap.local/account/123',
50             #pod });
51             #pod
52             #pod my $response = $jtest->request([
53             #pod [ 'Mailbox/get' => {} ],
54             #pod [ 'Email/changes' => { sinceState => "123" } ],
55             #pod ]);
56             #pod
57             #pod # This returns two Paragraph objects if there are exactly two paragraphs.
58             #pod # Otherwise, it throws an exception.
59             #pod my ($mbx_p, $msg_p) = $response->assert_n_paragraphs(2);
60             #pod
61             #pod # These get the single Sentence of each paragraph, asserting that there is
62             #pod # exactly one Sentence in each Paragraph, and that it's of the given type.
63             #pod my $mbx = $mbx_p->single('Mailbox/get');
64             #pod my $msg = $msg_p->single('Email/changes');
65             #pod
66             #pod is( @{ $mbx->arguments->{list} }, 10, "we expect 10 mailboxes");
67             #pod ok( ! $msg->arguments->{hasMoreChanges}, "we got all the msg updates needed");
68             #pod
69             #pod By default, all the structures returned have been passed through
70             #pod L, so you may want to strip their type data before using normal
71             #pod Perl code on them. You can do that with:
72             #pod
73             #pod my $struct = $response->as_triples; # gets the complete JSON data
74             #pod $jtest->strip_json_types( $struct ); # strips all the JSON::Typist types
75             #pod
76             #pod Or more simply:
77             #pod
78             #pod my $struct = $response->as_stripped_triples;
79             #pod
80             #pod There is also L.
81             #pod
82             #pod =cut
83              
84             #pod =attr should_return_futures
85             #pod
86             #pod If true, this indicates that the various network-accessing methods should
87             #pod return L objects rather than immediate results.
88             #pod
89             #pod =cut
90              
91             has should_return_futures => (
92             is => 'ro',
93             default => 0,
94             );
95              
96             # When something doesn't work — not an individual method call, but the whole
97             # HTTP call, somehow — then the future will fail, and the failure might be a
98             # JMAP tester failure object, meaning we semi-expected it, or it might be some
99             # other crazy failure, meaning we had no way of seeing it coming.
100             #
101             # We use Future->fail because that way we can use ->else in chains to only act
102             # on successful HTTP calls. At the end, it's fine if you're expecting a future
103             # and can know that a failed future is a fail and a done future is okay. In the
104             # old calling convention, though, you expect to get a success/fail object as
105             # long as you got an HTTP response. Otherwise, you'd get an exception.
106             #
107             # $Failsafe emulates that. Just before we return from a future-returning
108             # method, and if the client is not set to return futures, we do this:
109             #
110             # * successful futures return their payload, the Result object
111             # * failed futures that contain a JMAP tester Failure return the failure
112             # * other failed futures die, like they would if you called $failed_future->get
113             my $Failsafe = sub {
114             $_[0]->else_with_f(sub {
115             my ($f, $fail) = @_;
116             return $fail->$_isa('JMAP::Tester::Result::Failure') ? Future->done($fail)
117             : $f;
118             });
119             };
120              
121             #pod =attr json_pretty
122             #pod
123             #pod This is a boolean which, if true, will cause the JMAP::Tester object to
124             #pod canonicalize and pretty-print generated JSON.
125             #pod
126             #pod =cut
127              
128             has json_pretty => (
129             is => 'ro',
130             default => 0,
131             );
132              
133             #pod =attr json_codec
134             #pod
135             #pod This is an object that implements the JSON API, roughly meaning that it
136             #pod provides C and C methods. You probably won't need to use
137             #pod anything but the default version outside of exceptional cases.
138             #pod
139             #pod =cut
140              
141             has json_codec => (
142             is => 'bare',
143             reader => '_json_codec',
144             lazy => 1,
145             handles => {
146             json_decode => 'decode',
147             },
148             default => sub {
149             my ($self) = @_;
150              
151             require JSON::XS;
152             my $json = JSON::XS->new->utf8->convert_blessed;
153              
154             if ($self->json_pretty) {
155             $json = $json->pretty->canonical;
156             }
157             return $json;
158             },
159             );
160              
161 4     4 0 5 sub json_encode ($self, $data) {
  4         6  
  4         5  
  4         4  
162 4 100       11 if ($data->$_isa('JMAP::Tester::JSONLiteral')) {
163 1         12 return $data->bytes;
164             }
165              
166 3         97 $self->_json_codec->encode($data);
167             }
168              
169             #pod =attr use_json_typists
170             #pod
171             #pod This attribute governs the conversion of JSON data into typed objects, using
172             #pod L. This attribute is true by default.
173             #pod
174             #pod =cut
175              
176             has use_json_typist => (
177             is => 'ro',
178             default => 1,
179             );
180              
181             has _json_typist => (
182             is => 'ro',
183             handles => {
184             strip_json_types => 'strip_types',
185             },
186             default => sub {
187             require JSON::Typist;
188             return JSON::Typist->new;
189             },
190             );
191              
192 9     9 0 265 sub apply_json_types ($self, $data) {
  9         11  
  9         12  
  9         12  
193 9 100       32 return $data unless $self->use_json_typist;
194 8         45 return $self->_json_typist->apply_types($data);
195             }
196              
197             for my $type (qw(api authentication download upload)) {
198             has "$type\_uri" => (
199             is => 'rw',
200             predicate => "has_$type\_uri",
201             clearer => "clear_$type\_uri",
202             );
203             }
204              
205             has ua => (
206             is => 'ro',
207             default => sub {
208             require JMAP::Tester::UA::LWP;
209             JMAP::Tester::UA::LWP->new;
210             },
211             );
212              
213             #pod =attr ident
214             #pod
215             #pod This is a (preferably short) string that can be used to identify this
216             #pod JMAP::Tester object. It's used in request logging, so that client telemetry
217             #pod can be correlated to a specific client object. If no ident is given, an ident
218             #pod will be generated, but it is not guaranteed to be unique.
219             #pod
220             #pod =cut
221              
222             has ident => (
223             is => 'ro',
224             default => sub {
225             my ($self) = @_;
226             state $ident_counter = 0;
227             return "jmap-tester-" . (++$ident_counter);
228             }
229             );
230              
231             #pod =attr default_using
232             #pod
233             #pod This is an arrayref of strings that specify which capabilities the client
234             #pod wishes to use. (See L
235             #pod for more info). By default, JMAP::Tester will not send a 'using' parameter.
236             #pod
237             #pod =cut
238              
239             has default_using => (
240             is => 'rw',
241             predicate => '_has_default_using',
242             );
243              
244             #pod =attr default_arguments
245             #pod
246             #pod This is a hashref of arguments to be put into each method call. It's
247             #pod especially useful for setting a default C. Values given in methods
248             #pod passed to C will override defaults. If the value is a reference to
249             #pod C, then no value will be passed for that key.
250             #pod
251             #pod In other words, in this situation:
252             #pod
253             #pod my $tester = JMAP::Tester->new({
254             #pod ...,
255             #pod default_arguments => { a => 1, b => 2, c => 3 },
256             #pod });
257             #pod
258             #pod $tester->request([
259             #pod [ eatPies => { a => 100, b => \undef } ],
260             #pod ]);
261             #pod
262             #pod The request will effectively be:
263             #pod
264             #pod [ [ "eatPies", { "a": 100, "c": 3 }, "a" ] ]
265             #pod
266             #pod =cut
267              
268             has default_arguments => (
269             is => 'rw',
270             default => sub { {} },
271             );
272              
273             #pod =attr accounts
274             #pod
275             #pod This method will return a list of pairs mapping accountIds to accounts
276             #pod as provided by the client session object if any have been configured.
277             #pod
278             #pod =cut
279              
280             has _accounts => (
281             is => 'rw',
282             init_arg => undef,
283             predicate => '_has_accounts',
284             );
285              
286 1     1 1 11832 sub accounts ($self) {
  1         1  
  1         2  
287 1 50       5 return unless $self->_has_accounts;
288 1         2 return %{ $self->_accounts }
  1         7  
289             }
290              
291             #pod =method primary_account_for
292             #pod
293             #pod my $account_id = $tester->primary_account_for($using);
294             #pod
295             #pod This returns the primary accountId to be used for the given capability, or
296             #pod undef if none is available. This is only useful if the tester has been
297             #pod configured from a client session.
298             #pod
299             #pod =cut
300              
301             has _primary_accounts => (
302             is => 'rw',
303             init_arg => undef,
304             predicate => '_has_primary_accounts',
305             );
306              
307 4     4 1 7650 sub primary_account_for ($self, $using) {
  4         9  
  4         7  
  4         4  
308 4 50       15 return unless $self->_has_primary_accounts;
309 4         28 return $self->_primary_accounts->{ $using };
310             }
311              
312             #pod =method request
313             #pod
314             #pod my $result = $jtest->request([
315             #pod [ methodOne => { ... } ],
316             #pod [ methodTwo => { ... } ],
317             #pod ]);
318             #pod
319             #pod This method accepts either an arrayref of method calls or a hashref with a
320             #pod C key. It sends the calls to the JMAP server and returns a
321             #pod result.
322             #pod
323             #pod For each method call, if there's a third element (a I) then it's
324             #pod left as-is. If no client id is given, one is generated. You can mix explicit
325             #pod and autogenerated client ids. They will never conflict.
326             #pod
327             #pod The arguments to methods are JSON-encoded with a L-aware encoder,
328             #pod so JSON::Typist types can be used to ensure string or number types in the
329             #pod generated JSON. If an argument is a reference to C, it will be removed
330             #pod before the method call is made. This lets you override a default by omission.
331             #pod
332             #pod The return value is an object that does the L role,
333             #pod meaning it's got an C method that returns true or false. For now,
334             #pod at least, failures are L objects. More refined
335             #pod failure objects may exist in the future. Successful requests return
336             #pod L objects.
337             #pod
338             #pod Before the JMAP request is made, each triple is passed to a method called
339             #pod C, which can tweak the method however it likes.
340             #pod
341             #pod This method respects the C attributes of the
342             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
343             #pod to the Result.
344             #pod
345             #pod =cut
346              
347 4     4 1 3558 sub request ($self, $input_request) {
  4         8  
  4         9  
  4         6  
348 4 50       22 Carp::confess("can't perform request: no api_uri configured")
349             unless $self->has_api_uri;
350              
351 4         8 state $ident = 'a';
352 4         9 my %seen;
353             my @suffixed;
354              
355 4         7 my %default_args = %{ $self->default_arguments };
  4         17  
356              
357 4         7 my $request;
358              
359 4 100       23 if ($input_request->$_isa('JMAP::Tester::JSONLiteral')) {
360             # We'll be "encoding" (read: not really encoding) this directly, with no
361             # munging of the content, no creation of call ids, etc.
362 1         16 $request = $input_request;
363             } else {
364 3 50       57 $request = _ARRAY0($input_request)
365             ? { methodCalls => $input_request }
366             : { %$input_request };
367              
368 3         6 for my $call (@{ $request->{methodCalls} }) {
  3         13  
369 3         24 my $copy = [ @$call ];
370 3 50       12 if (defined $copy->[2]) {
371 0         0 $seen{$call->[2]}++;
372             } else {
373 3         6 my $next;
374 3         6 do { $next = $ident++ } until ! $seen{$ident}++;
  3         20  
375 3         10 $copy->[2] = $next;
376             }
377              
378             my %arg = (
379             %default_args,
380 3   50     188 %{ $copy->[1] // {} },
  3         19  
381             );
382              
383 3         9 for my $key (keys %arg) {
384 3 50 66     22 if ( ref $arg{$key}
      33        
385             && ref $arg{$key} eq 'SCALAR'
386 0         0 && ! defined ${ $arg{$key} }
387             ) {
388 0         0 delete $arg{$key};
389             }
390             }
391              
392 3         8 $copy->[1] = \%arg;
393              
394             # Originally, I had a second argument, \%stash, which was the same for the
395             # whole ->request, so you could store data between munges. Removed, for
396             # now, as YAGNI. -- rjbs, 2019-03-04
397 3         14 $self->munge_method_triple($copy);
398              
399 3         7 push @suffixed, $copy;
400             }
401              
402 3         10 $request->{methodCalls} = \@suffixed;
403              
404             $request = $request->{methodCalls}
405 3 50 33     12 if $ENV{JMAP_TESTER_NO_WRAPPER} && _ARRAY0($input_request);
406              
407 3 50 33     15 if ($self->_has_default_using && ! exists $request->{using}) {
408 0         0 $request->{using} = $self->default_using;
409             }
410             }
411              
412 4         13 my $json = $self->json_encode($request);
413              
414 4         48 my $post = HTTP::Request->new(
415             POST => $self->api_uri,
416             [
417             'Content-Type' => 'application/json',
418             $self->_maybe_auth_header,
419             ],
420             $json,
421             );
422              
423 4         858 my $res_f = $self->ua->request($self, $post, jmap => {
424             jmap_array => \@suffixed,
425             json => $json,
426             });
427              
428             my $future = $res_f->then(sub {
429 4     4   222 my ($res) = @_;
430              
431 4 50       15 unless ($res->is_success) {
432 0         0 $self->_logger->log_jmap_response($self, { http_response => $res });
433 0         0 return Future->fail(
434             JMAP::Tester::Result::Failure->new({ http_response => $res })
435             );
436             }
437              
438 4         60 return Future->done($self->_jresponse_from_hresponse($res));
439 4         96 });
440              
441 4 50       176 return $self->should_return_futures ? $future : $future->$Failsafe->get;
442             }
443              
444       3 0   sub munge_method_triple {}
445              
446 8     8 0 196 sub response_class { 'JMAP::Tester::Response' }
447              
448 8     8   4925 sub _jresponse_from_hresponse ($self, $http_res) {
  8         12  
  8         13  
  8         10  
449             # TODO check that it's really application/json!
450 8         33 my $json = $http_res->decoded_content;
451              
452 8         1381 my $data = $self->apply_json_types( $self->json_decode( $json ) );
453              
454 8         1060 my ($items, $props);
455 8 100       27 if (_HASH0($data)) {
    50          
456 7         9 $props = $data;
457 7         15 $items = $props->{methodResponses};
458             } elsif (_ARRAY0($data)) {
459 1         1 $props = {};
460 1         3 $items = $data;
461             } else {
462 0         0 abort("illegal response to JMAP request: $data");
463             }
464              
465 8         58 $self->_logger->log_jmap_response(
466             $self,
467             {
468             jmap_array => $items,
469             json => $json,
470             http_response => $http_res,
471             }
472             );
473              
474 8         25 return $self->response_class->new({
475             items => $items,
476             http_response => $http_res,
477             wrapper_properties => $props,
478             });
479             }
480              
481             has _logger => (
482             is => 'ro',
483             default => sub {
484             if ($ENV{JMAP_TESTER_LOGGER}) {
485             my ($class, $filename) = split /:/, $ENV{JMAP_TESTER_LOGGER};
486             $class = "JMAP::Tester::Logger::$class";
487             Module::Runtime::require_module($class);
488              
489             return $class->new({
490             writer => $filename // 'jmap-tester-{T}-{PID}.log'
491             });
492             }
493              
494             JMAP::Tester::Logger::Null->new({ writer => \undef });
495             },
496             );
497              
498             #pod =method upload
499             #pod
500             #pod my $result = $tester->upload(\%arg);
501             #pod
502             #pod Required arguments are:
503             #pod
504             #pod accountId - the account for which we're uploading (no default)
505             #pod type - the content-type we want to provide to the server
506             #pod blob - the data to upload. Must be a reference to a string
507             #pod
508             #pod This uploads the given blob.
509             #pod
510             #pod The return value will either be a L
511             #pod object|JMAP::Tester::Result::Failure> or an L
512             #pod result|JMAP::Tester::Result::Upload>.
513             #pod
514             #pod This method respects the C attributes of the
515             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
516             #pod to the Result.
517             #pod
518             #pod =cut
519              
520 1     1 1 2 sub upload ($self, $arg) {
  1         1  
  1         3  
  1         2  
521             # TODO: support blob as handle or sub -- rjbs, 2016-11-17
522              
523 1         9 my $uri = $self->upload_uri;
524              
525 1 50       6 Carp::confess("can't upload without upload_uri")
526             unless $uri;
527              
528 1         4 for my $param (qw(accountId type blob)) {
529 3         7 my $value = $arg->{ $param };
530              
531 3 50       7 Carp::confess("missing required parameter $param")
532             unless defined $value;
533              
534 3 100       10 if ($param eq 'accountId') {
535 1         26 $uri =~ s/\{$param\}/$value/g;
536             }
537             }
538              
539             my $post = HTTP::Request->new(
540             POST => $uri,
541             [
542             'Content-Type' => $arg->{type},
543             $self->_maybe_auth_header,
544             ],
545 1         4 ${ $arg->{blob} },
  1         9  
546             );
547              
548 1         231 my $res_f = $self->ua->request($self, $post, 'upload');
549              
550             my $future = $res_f->then(sub {
551 1     1   56 my ($res) = @_;
552              
553 1 50       4 unless ($res->is_success) {
554 0         0 $self->_logger->log_upload_response($self, { http_response => $res });
555 0         0 return Future->fail(
556             JMAP::Tester::Result::Failure->new({ http_response => $res })
557             );
558             }
559              
560 1         10 my $json = $res->decoded_content;
561 1         160 my $blob = $self->apply_json_types( $self->json_decode( $json ) );
562              
563 1         114 $self->_logger->log_upload_response(
564             $self,
565             {
566             json => $json,
567             blob_struct => $blob,
568             http_response => $res,
569             }
570             );
571              
572 1         14 return Future->done(
573             JMAP::Tester::Result::Upload->new({
574             http_response => $res,
575             payload => $blob,
576             })
577             );
578 1         34 });
579              
580 1 50       1199 return $self->should_return_futures ? $future : $future->$Failsafe->get;
581             }
582              
583             #pod =method download
584             #pod
585             #pod my $result = $tester->download(\%uri_arg, \%other_arg);
586             #pod
587             #pod The first hashref provides values that go into the download URI:
588             #pod
589             #pod blobId - the blob to download (no default)
590             #pod accountId - the account for which we're downloading (no default)
591             #pod type - the content-type we want the server to provide back (no default)
592             #pod name - the name we want the server to provide back (default: "download")
593             #pod
594             #pod If the download URI template has a C, C, or C
595             #pod placeholder but no argument for that is given to C, an exception
596             #pod will be thrown.
597             #pod
598             #pod The second hashref, which is optional, provides other arguments to the method.
599             #pod Right now, there is only one, B. The argument is only here
600             #pod for legacy purposes, specifically for the Cyrus IMAP project, and may be
601             #pod removed B.
602             #pod
603             #pod accept - the value of the Accept header to use when downloading
604             #pod
605             #pod The return value will either be a L
606             #pod object|JMAP::Tester::Result::Failure> or an L
607             #pod result|JMAP::Tester::Result::Download>.
608             #pod
609             #pod This method respects the C attributes of the
610             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
611             #pod to the Result.
612             #pod
613             #pod =cut
614              
615             my %DL_DEFAULT = (name => 'download');
616              
617 0     0   0 sub _jwt_sub_param_from_uri ($self, $to_sign) {
  0         0  
  0         0  
  0         0  
618 0         0 "$to_sign";
619             }
620              
621 1     1 0 2 sub download_uri_for ($self, $arg) {
  1         1  
  1         2  
  1         1  
622 1 50       6 Carp::confess("can't compute download URI without configured download_uri")
623             unless my $uri = $self->download_uri;
624              
625 1         3 for my $param (qw(blobId accountId name type)) {
626 4 50       43 next unless $uri =~ /\{$param\}/;
627 4   33     10 my $value = $arg->{ $param } // $DL_DEFAULT{ $param };
628              
629 4 50       6 Carp::confess("missing required template parameter $param")
630             unless defined $value;
631              
632 4 100       5 if ($param eq 'name') {
633 1         5 $value = uri_escape($value);
634             }
635              
636 4         69 $uri =~ s/\{$param\}/$value/g;
637             }
638              
639 1 50       3 if (my $jwtc = $self->_get_jwt_config) {
640 0         0 my $to_get = URI->new($uri);
641 0         0 my $to_sign = $to_get->clone->canonical;
642              
643 0         0 $to_sign->query(undef);
644              
645 0         0 my $header = encode_b64u( $self->json_encode({
646             alg => 'HS256',
647             typ => 'JWT',
648             }) );
649              
650 0         0 my $iat = time;
651 0         0 $iat = $iat - ($iat % 3600);
652              
653             my $payload = encode_b64u( $self->json_encode({
654             iss => $jwtc->{signingId},
655 0         0 iat => $iat,
656             sub => $self->_jwt_sub_param_from_uri($to_sign),
657             }) );
658              
659             my $signature = hmac_b64u(
660             'SHA256',
661 0         0 decode_b64u($jwtc->{signingKey}),
662             "$header.$payload",
663             );
664              
665 0         0 $to_get->query_param(access_token => "$header.$payload.$signature");
666 0         0 $uri = "$to_get";
667             }
668              
669 1         3 return $uri;
670             }
671              
672 1     1 1 3 sub download ($self, $uri_arg, $arg = undef) {
  1         2  
  1         2  
  1         1  
  1         2  
673 1   50     6 $arg //= {};
674              
675 1         3 my $uri = $self->download_uri_for($uri_arg);
676              
677             my $get = HTTP::Request->new(
678             GET => $uri,
679             [
680             $self->_maybe_auth_header,
681 1 50       3 ($arg->{accept} ? (Accept => $arg->{accept}) : ()),
682             ],
683             );
684              
685 1         119 my $res_f = $self->ua->request($self, $get, 'download');
686              
687             my $future = $res_f->then(sub {
688 1     1   55 my ($res) = @_;
689              
690 1         9 $self->_logger->log_download_response($self, { http_response => $res });
691              
692 1 50       3 unless ($res->is_success) {
693 0         0 return Future->fail(
694             JMAP::Tester::Result::Failure->new({ http_response => $res })
695             );
696             }
697              
698 1         17 return Future->done(
699             JMAP::Tester::Result::Download->new({ http_response => $res })
700             );
701 1         31 });
702              
703 1 50       1168 return $self->should_return_futures ? $future : $future->$Failsafe->get;
704             }
705              
706 9     9   17 sub _maybe_auth_header ($self) {
  9         15  
  9         14  
707 9 50       124 return ($self->_access_token
708             ? (Authorization => "Bearer " . $self->_access_token)
709             : ());
710             }
711              
712             has _jwt_config => (
713             is => 'rw',
714             init_arg => undef,
715             );
716              
717             sub _now_timestamp {
718             # 0 1 2 3 4 5
719 0     0   0 my ($sec, $min, $hour, $mday, $mon, $year) = gmtime;
720 0         0 return sprintf '%04u-%02u-%02uT%02u:%02u:%02uZ',
721             $year + 1900, $mon + 1, $mday,
722             $hour, $min, $sec;
723             }
724              
725 1     1   1 sub _get_jwt_config ($self) {
  1         2  
  1         1  
726 1 50       10 return unless my $jwtc = $self->_jwt_config;
727 0 0       0 return $jwtc unless $jwtc->{signingKeyValidUntil};
728 0 0       0 return $jwtc if $jwtc->{signingKeyValidUntil} gt $self->_now_timestamp;
729              
730 0         0 $self->update_client_session;
731 0 0       0 return unless $jwtc = $self->_jwt_config;
732 0         0 return $jwtc;
733             }
734              
735             has _access_token => (
736             is => 'rw',
737             init_arg => undef,
738             );
739              
740             #pod =method get_client_session
741             #pod
742             #pod $tester->get_client_session;
743             #pod $tester->get_client_session($auth_uri);
744             #pod
745             #pod This method fetches the content at the authentication endpoint.
746             #pod
747             #pod This method respects the C attributes of the
748             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
749             #pod to the L object.
750             #pod
751             #pod =cut
752              
753 3     3   6 sub _get_client_session_future ($self, $auth_uri = undef) {
  3         5  
  3         7  
  3         5  
754 3   66     39 $auth_uri //= $self->authentication_uri;
755              
756 3         16 my $auth_req = HTTP::Request->new(
757             GET => $auth_uri,
758             [
759             $self->_maybe_auth_header,
760             'Accept' => 'application/json',
761             ],
762             );
763              
764             my $future = $self->ua->request($self, $auth_req, 'auth')->then(sub {
765 3     3   308 my ($res) = @_;
766              
767 3 100       9 unless ($res->code == 200) {
768 1         22 return Future->fail(
769             JMAP::Tester::Result::Failure->new({
770             ident => 'failure to get updated authentication data',
771             http_response => $res,
772             })
773             );
774             }
775              
776 2         30 my $client_session = $self->json_decode( $res->decoded_content );
777              
778 2         273 my $auth = JMAP::Tester::Result::Auth->new({
779             http_response => $res,
780             client_session => $client_session,
781             });
782              
783 2         1117 return Future->done($auth);
784 3         12769 });
785             }
786              
787 2     2 1 20359 sub get_client_session ($self, $auth_uri = undef) {
  2         5  
  2         4  
  2         5  
788 2         12 my $future = $self->_get_client_session_future($auth_uri);
789 2 50       1245 return $self->should_return_futures ? $future : $future->$Failsafe->get;
790             }
791              
792             #pod =method update_client_session
793             #pod
794             #pod $tester->update_client_session;
795             #pod $tester->update_client_session($auth_uri);
796             #pod
797             #pod This method fetches the content at the authentication endpoint and uses it to
798             #pod configure the tester's target URIs and signing keys.
799             #pod
800             #pod This method respects the C attributes of the
801             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
802             #pod to the Result.
803             #pod
804             #pod =cut
805              
806 1     1 1 2565 sub update_client_session ($self, $auth_uri = undef) {
  1         3  
  1         3  
  1         2  
807             my $future = $self->_get_client_session_future($auth_uri)->then(sub {
808 1     1   82 my ($auth) = @_;
809              
810 1         23 $self->configure_from_client_session($auth->client_session);
811              
812 1         4 return Future->done($auth);
813 1         5 });
814              
815 1 50       37 return $self->should_return_futures ? $future : $future->$Failsafe->get;
816             }
817              
818             #pod =method configure_from_client_session
819             #pod
820             #pod $tester->configure_from_client_session($client_session);
821             #pod
822             #pod Given a client session object (like those stored in an Auth result), this
823             #pod reconfigures the testers access token, signing keys, URIs, and so forth. This
824             #pod method is used internally when logging in.
825             #pod
826             #pod =cut
827              
828 1     1 1 2 sub configure_from_client_session ($self, $client_session) {
  1         34  
  1         2  
  1         2  
829             # It's not crazy to think that we'd also try to pull the primary accountId
830             # out of the accounts in the auth struct, but I don't think there's a lot to
831             # gain by doing that yet. Maybe later we'd use it to set the default
832             # X-JMAP-AccountId or other things, but I think there are too many open
833             # questions. I'm leaving it out on purpose for now. -- rjbs, 2016-11-18
834              
835             # This is no longer fatal because you might be an anonymous session that
836             # needs to call this to fetch an updated signing key. -- rjbs, 2017-03-23
837             # abort("no accessToken in client session object")
838             # unless $client_session->{accessToken};
839              
840 1         10 $self->_access_token($client_session->{accessToken});
841              
842 1 50 33     6 if ($client_session->{signingId} && $client_session->{signingKey}) {
843             $self->_jwt_config({
844             signingId => $client_session->{signingId},
845             signingKey => $client_session->{signingKey},
846             signingKeyValidUntil => $client_session->{signingKeyValidUntil},
847 0         0 });
848             } else {
849 1         5 $self->_jwt_config(undef);
850             }
851              
852 1         2 for my $type (qw(api download upload)) {
853 3 50       8 if (defined (my $uri = $client_session->{"${type}Url"})) {
854 3         4 my $setter = "$type\_uri";
855 3         10 $self->$setter($uri);
856             } else {
857 0         0 my $clearer = "clear_$type\_uri";
858 0         0 $self->$clearer;
859             }
860             }
861              
862 1         15 $self->_primary_accounts($client_session->{primaryAccounts});
863 1         4 $self->_accounts($client_session->{accounts});
864              
865 1         2 return;
866             }
867              
868             #pod =method logout
869             #pod
870             #pod $tester->logout;
871             #pod
872             #pod This method attempts to log out from the server by sending a C request
873             #pod to the authentication URI.
874             #pod
875             #pod This method respects the C attributes of the
876             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
877             #pod to the Result.
878             #pod
879             #pod =cut
880              
881 0     0 1   sub logout ($self) {
  0            
  0            
882             # This is fatal, not a failure return, because it reflects the user screwing
883             # up, not a possible JMAP-related condition. -- rjbs, 2017-02-10
884 0 0         Carp::confess("can't logout: no authentication_uri configured")
885             unless $self->has_authentication_uri;
886              
887 0           my $req = HTTP::Request->new(
888             DELETE => $self->authentication_uri,
889             [
890             'Content-Type' => 'application/json; charset=utf-8',
891             'Accept' => 'application/json',
892             ],
893             );
894              
895             my $future = $self->ua->request($self, $req, 'auth')->then(sub {
896 0     0     my ($res) = @_;
897              
898 0 0         if ($res->code == 204) {
899 0           $self->_access_token(undef);
900              
901 0           return Future->done(
902             JMAP::Tester::Result::Logout->new({
903             http_response => $res,
904             })
905             );
906             }
907              
908 0           return Future->fail(
909             JMAP::Tester::Result::Failure->new({
910             ident => "failed to log out",
911             http_response => $res,
912             })
913             );
914 0           });
915              
916 0 0         return $self->should_return_futures ? $future : $future->$Failsafe->get;
917             }
918              
919             #pod =method http_request
920             #pod
921             #pod my $response = $jtest->http_request($http_request);
922             #pod
923             #pod Sometimes, you may need to make an HTTP request with your existing web
924             #pod connection. This might be to interact with a custom authentication mechanism,
925             #pod to access custom endpoints, or just to make very, very specifically crafted
926             #pod requests. For this reasons, C exists.
927             #pod
928             #pod Pass this method an L and it will use the tester's UA object to
929             #pod make the request.
930             #pod
931             #pod This method respects the C attributes of the
932             #pod JMAP::Tester object, and in futures mode will return a future that will resolve
933             #pod to the L.
934             #pod
935             #pod =cut
936              
937 0     0 1   sub http_request ($self, $http_request) {
  0            
  0            
  0            
938 0           my $future = $self->ua->request($self, $http_request, 'misc');
939 0 0         return $self->should_return_futures ? $future : $future->$Failsafe->get;
940             }
941              
942             #pod =method http_get
943             #pod
944             #pod my $response = $jtest->http_get($url, $headers);
945             #pod
946             #pod This method is just sugar for calling C to make a GET request for
947             #pod the given URL. C<$headers> is an optional arrayref of headers.
948             #pod
949             #pod =cut
950              
951 0     0 1   sub http_get ($self, $url, $headers = undef) {
  0            
  0            
  0            
  0            
952 0 0         my $req = HTTP::Request->new(
953             GET => $url,
954             (defined $headers ? $headers : ()),
955             );
956 0           return $self->http_request($req);
957             }
958              
959             #pod =method http_post
960             #pod
961             #pod my $response = $jtest->http_post($url, $body, $headers);
962             #pod
963             #pod This method is just sugar for calling C to make a POST request
964             #pod for the given URL. C<$headers> is an arrayref of headers and C<$body> is the
965             #pod byte string to be passed as the body.
966             #pod
967             #pod =cut
968              
969 0     0 1   sub http_post ($self, $url, $body, $headers = undef) {
  0            
  0            
  0            
  0            
  0            
970 0   0       my $req = HTTP::Request->new(
971             POST => $url,
972             $headers // [],
973             $body,
974             );
975              
976 0           return $self->http_request($req);
977             }
978              
979             1;
980              
981             __END__