File Coverage

blib/lib/JMAP/Tester.pm
Criterion Covered Total %
statement 80 258 31.0
branch 3 86 3.4
condition 0 27 0.0
subroutine 25 49 51.0
pod 12 15 80.0
total 120 435 27.5


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