File Coverage

blib/lib/JMAP/Tester.pm

Criterion	Covered	Total	%
statement	267	322	82.9
branch	44	86	51.1
condition	11	27	40.7
subroutine	49	54	90.7
pod	12	17	70.5
total	383	506	75.6

package JMAP::Tester 0.110;
# ABSTRACT: a JMAP client made for testing JMAP servers

use v5.20.0;
use warnings;

use Moo;

use experimental 'signatures';

use Crypt::Misc qw(decode_b64u encode_b64u);
use Crypt::Mac::HMAC qw(hmac_b64u);
use Encode qw(encode_utf8);
use Future;
use HTTP::Request;
use JMAP::Tester::Abort 'abort';
use JMAP::Tester::Logger::Null;
use JMAP::Tester::Response;
use JMAP::Tester::Result::Auth;
use JMAP::Tester::Result::Download;
use JMAP::Tester::Result::Failure;
use JMAP::Tester::Result::Logout;
use JMAP::Tester::Result::Upload;
use Module::Runtime ();
use Params::Util qw(_HASH0 _ARRAY0);
use Safe::Isa;
use URI;
use URI::QueryParam;
use URI::Escape qw(uri_escape);

use namespace::clean;

#pod =head1 OVERVIEW
#pod
#pod B  This library is in its really early days, so use it with that in
#pod mind.
#pod
#pod JMAP::Tester is for testing JMAP servers.  Okay?  Okay!
#pod
#pod JMAP::Tester calls the whole thing you get back from a JMAP server a "response"
#pod if it's an HTTP 200.  Every JSON Array (of three entries -- go read the spec if
#pod you need to!) is called a L.  Runs
#pod of Sentences with the same client id are called
#pod L.
#pod
#pod You use the test client like this:
#pod
#pod   my $jtest = JMAP::Tester->new({
#pod     api_uri => 'https://jmap.local/account/123',
#pod   });
#pod
#pod   my $response = $jtest->request([
#pod     [ 'Mailbox/get' => {} ],
#pod     [ 'Email/changes' => { sinceState => "123" } ],
#pod   ]);
#pod
#pod   # This returns two Paragraph objects if there are exactly two paragraphs.
#pod   # Otherwise, it throws an exception.
#pod   my ($mbx_p, $msg_p) = $response->assert_n_paragraphs(2);
#pod
#pod   # These get the single Sentence of each paragraph, asserting that there is
#pod   # exactly one Sentence in each Paragraph, and that it's of the given type.
#pod   my $mbx = $mbx_p->single('Mailbox/get');
#pod   my $msg = $msg_p->single('Email/changes');
#pod
#pod   is( @{ $mbx->arguments->{list} }, 10, "we expect 10 mailboxes");
#pod   ok( ! $msg->arguments->{hasMoreChanges}, "we got all the msg updates needed");
#pod
#pod By default, all the structures returned have been passed through
#pod L, so you may want to strip their type data before using normal
#pod Perl code on them.  You can do that with:
#pod
#pod   my $struct = $response->as_triples;  # gets the complete JSON data
#pod   $jtest->strip_json_types( $struct ); # strips all the JSON::Typist types
#pod
#pod Or more simply:
#pod
#pod   my $struct = $response->as_stripped_triples;
#pod
#pod There is also L.
#pod
#pod =cut

#pod =attr should_return_futures
#pod
#pod If true, this indicates that the various network-accessing methods should
#pod return L objects rather than immediate results.
#pod
#pod =cut

has should_return_futures => (
  is  => 'ro',
  default => 0,
);

# When something doesn't work — not an individual method call, but the whole
# HTTP call, somehow — then the future will fail, and the failure might be a
# JMAP tester failure object, meaning we semi-expected it, or it might be some
# other crazy failure, meaning we had no way of seeing it coming.
#
# We use Future->fail because that way we can use ->else in chains to only act
# on successful HTTP calls. At the end, it's fine if you're expecting a future
# and can know that a failed future is a fail and a done future is okay. In the
# old calling convention, though, you expect to get a success/fail object as
# long as you got an HTTP response.  Otherwise, you'd get an exception.
#
# $Failsafe emulates that. Just before we return from a future-returning
# method, and if the client is not set to return futures, we do this:
#
# * successful futures return their payload, the Result object
# * failed futures that contain a JMAP tester Failure return the failure
# * other failed futures die, like they would if you called $failed_future->get
my $Failsafe = sub {
  $_[0]->else_with_f(sub {
    my ($f, $fail) = @_;
    return $fail->$_isa('JMAP::Tester::Result::Failure') ? Future->done($fail)
                                                         : $f;
  });
};

#pod =attr json_pretty
#pod
#pod This is a boolean which, if true, will cause the JMAP::Tester object to
#pod canonicalize and pretty-print generated JSON.
#pod
#pod =cut

has json_pretty => (
  is => 'ro',
  default => 0,
);

#pod =attr json_codec
#pod
#pod This is an object that implements the JSON API, roughly meaning that it
#pod provides C and C methods.  You probably won't need to use
#pod anything but the default version outside of exceptional cases.
#pod
#pod =cut

has json_codec => (
  is => 'bare',
  reader => '_json_codec',
  lazy => 1,
  handles => {
    json_decode => 'decode',
  },
  default => sub {
    my ($self) = @_;

    require JSON::XS;
    my $json = JSON::XS->new->utf8->convert_blessed;

    if ($self->json_pretty) {
      $json = $json->pretty->canonical;
    }
    return $json;
  },
);

sub json_encode ($self, $data) {
  if ($data->$_isa('JMAP::Tester::JSONLiteral')) {
    return $data->bytes;
  }

  $self->_json_codec->encode($data);
}

#pod =attr use_json_typists
#pod
#pod This attribute governs the conversion of JSON data into typed objects, using
#pod L.  This attribute is true by default.
#pod
#pod =cut

has use_json_typist => (
  is => 'ro',
  default => 1,
);

has _json_typist => (
  is => 'ro',
  handles => {
    strip_json_types => 'strip_types',
  },
  default => sub {
    require JSON::Typist;
    return JSON::Typist->new;
  },
);

sub apply_json_types ($self, $data) {
  return $data unless $self->use_json_typist;
  return $self->_json_typist->apply_types($data);
}

for my $type (qw(api authentication download upload)) {
  has "$type\_uri" => (
    is => 'rw',
    predicate => "has_$type\_uri",
    clearer   => "clear_$type\_uri",
  );
}

has ua => (
  is => 'ro',
  default => sub {
    require JMAP::Tester::UA::LWP;
    JMAP::Tester::UA::LWP->new;
  },
);

#pod =attr ident
#pod
#pod This is a (preferably short) string that can be used to identify this
#pod JMAP::Tester object.  It's used in request logging, so that client telemetry
#pod can be correlated to a specific client object.  If no ident is given, an ident
#pod will be generated, but it is not guaranteed to be unique.
#pod
#pod =cut

has ident => (
  is => 'ro',
  default => sub {
    my ($self) = @_;
    state $ident_counter = 0;
    return "jmap-tester-" . (++$ident_counter);
  }
);

#pod =attr default_using
#pod
#pod This is an arrayref of strings that specify which capabilities the client
#pod wishes to use. (See L
#pod for more info). By default, JMAP::Tester will not send a 'using' parameter.
#pod
#pod =cut

has default_using => (
  is => 'rw',
  predicate => '_has_default_using',
);

#pod =attr default_arguments
#pod
#pod This is a hashref of arguments to be put into each method call.  It's
#pod especially useful for setting a default C.  Values given in methods
#pod passed to C will override defaults.  If the value is a reference to
#pod C, then no value will be passed for that key.
#pod
#pod In other words, in this situation:
#pod
#pod   my $tester = JMAP::Tester->new({
#pod     ...,
#pod     default_arguments => { a => 1, b => 2, c => 3 },
#pod   });
#pod
#pod   $tester->request([
#pod     [ eatPies => { a => 100, b => \undef } ],
#pod   ]);
#pod
#pod The request will effectively be:
#pod
#pod   [ [ "eatPies", { "a": 100, "c": 3 }, "a" ] ]
#pod
#pod =cut

has default_arguments => (
  is  => 'rw',
  default => sub {  {}  },
);

#pod =attr accounts
#pod
#pod This method will return a list of pairs mapping accountIds to accounts
#pod as provided by the client session object if any have been configured.
#pod
#pod =cut

has _accounts => (
  is        => 'rw',
  init_arg  => undef,
  predicate => '_has_accounts',
);

sub accounts ($self) {
  return unless $self->_has_accounts;
  return %{ $self->_accounts }
}

#pod =method primary_account_for
#pod
#pod   my $account_id = $tester->primary_account_for($using);
#pod
#pod This returns the primary accountId to be used for the given capability, or
#pod undef if none is available.  This is only useful if the tester has been
#pod configured from a client session.
#pod
#pod =cut

has _primary_accounts => (
  is        => 'rw',
  init_arg  => undef,
  predicate => '_has_primary_accounts',
);

sub primary_account_for ($self, $using) {
  return unless $self->_has_primary_accounts;
  return $self->_primary_accounts->{ $using };
}

#pod =method request
#pod
#pod   my $result = $jtest->request([
#pod     [ methodOne => { ... } ],
#pod     [ methodTwo => { ... } ],
#pod   ]);
#pod
#pod This method accepts either an arrayref of method calls or a hashref with a
#pod C key.  It sends the calls to the JMAP server and returns a
#pod result.
#pod
#pod For each method call, if there's a third element (a I) then it's
#pod left as-is.  If no client id is given, one is generated.  You can mix explicit
#pod and autogenerated client ids.  They will never conflict.
#pod
#pod The arguments to methods are JSON-encoded with a L-aware encoder,
#pod so JSON::Typist types can be used to ensure string or number types in the
#pod generated JSON.  If an argument is a reference to C, it will be removed
#pod before the method call is made.  This lets you override a default by omission.
#pod
#pod The return value is an object that does the L role,
#pod meaning it's got an C method that returns true or false.  For now,
#pod at least, failures are L objects.  More refined
#pod failure objects may exist in the future.  Successful requests return
#pod L objects.
#pod
#pod Before the JMAP request is made, each triple is passed to a method called
#pod C, which can tweak the method however it likes.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the Result.
#pod
#pod =cut

sub request ($self, $input_request) {
  Carp::confess("can't perform request: no api_uri configured")
    unless $self->has_api_uri;

  state $ident = 'a';
  my %seen;
  my @suffixed;

  my %default_args = %{ $self->default_arguments };

  my $request;

  if ($input_request->$_isa('JMAP::Tester::JSONLiteral')) {
    # We'll be "encoding" (read: not really encoding) this directly, with no
    # munging of the content, no creation of call ids, etc.
    $request = $input_request;
  } else {
    $request = _ARRAY0($input_request)
             ? { methodCalls => $input_request }
             : { %$input_request };

    for my $call (@{ $request->{methodCalls} }) {
      my $copy = [ @$call ];
      if (defined $copy->[2]) {
        $seen{$call->[2]}++;
      } else {
        my $next;
        do { $next = $ident++ } until ! $seen{$ident}++;
        $copy->[2] = $next;
      }

      my %arg = (
        %default_args,
        %{ $copy->[1] // {} },
      );

      for my $key (keys %arg) {
        if ( ref $arg{$key}
          && ref $arg{$key} eq 'SCALAR'
          && ! defined ${ $arg{$key} }
        ) {
          delete $arg{$key};
        }
      }

      $copy->[1] = \%arg;

      # Originally, I had a second argument, \%stash, which was the same for the
      # whole ->request, so you could store data between munges.  Removed, for
      # now, as YAGNI. -- rjbs, 2019-03-04
      $self->munge_method_triple($copy);

      push @suffixed, $copy;
    }

    $request->{methodCalls} = \@suffixed;

    $request = $request->{methodCalls}
      if $ENV{JMAP_TESTER_NO_WRAPPER} && _ARRAY0($input_request);

    if ($self->_has_default_using && ! exists $request->{using}) {
      $request->{using} = $self->default_using;
    }
  }

  my $json = $self->json_encode($request);

  my $post = HTTP::Request->new(
    POST => $self->api_uri,
    [
      'Content-Type' => 'application/json',
      $self->_maybe_auth_header,
    ],
    $json,
  );

  my $res_f = $self->ua->request($self, $post, jmap => {
    jmap_array   => \@suffixed,
    json         => $json,
  });

  my $future = $res_f->then(sub {
    my ($res) = @_;

    unless ($res->is_success) {
      $self->_logger->log_jmap_response($self, { http_response => $res });
      return Future->fail(
        JMAP::Tester::Result::Failure->new({
          http_response => $res,
          diagnostic_dumper => $self->default_diagnostic_dumper,
        })
      );
    }

    return Future->done($self->_jresponse_from_hresponse($res));
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

sub munge_method_triple {}

sub response_class { 'JMAP::Tester::Response' }

sub _jresponse_from_hresponse ($self, $http_res) {
  # TODO check that it's really application/json!
  my $json = $http_res->decoded_content;

  my $data = $self->apply_json_types( $self->json_decode( $json ) );

  my ($items, $props);
  if (_HASH0($data)) {
    $props = $data;
    $items = $props->{methodResponses};
  } elsif (_ARRAY0($data)) {
    $props = {};
    $items = $data;
  } else {
    abort("illegal response to JMAP request: $data");
  }

  $self->_logger->log_jmap_response(
    $self,
    {
      jmap_array    => $items,
      json          => $json,
      http_response => $http_res,
    }
  );

  return $self->response_class->new({
    items => $items,
    http_response       => $http_res,
    wrapper_properties  => $props,
    diagnostic_dumper   => $self->default_diagnostic_dumper,
  });
}

has _logger => (
  is => 'ro',
  default => sub {
    if ($ENV{JMAP_TESTER_LOGGER}) {
      my ($class, $filename) = split /:/, $ENV{JMAP_TESTER_LOGGER};
      $class = "JMAP::Tester::Logger::$class";
      Module::Runtime::require_module($class);

      return $class->new({
        writer => $filename // 'jmap-tester-{T}-{PID}.log'
      });
    }

    JMAP::Tester::Logger::Null->new({ writer => \undef });
  },
);

#pod =method upload
#pod
#pod   my $result = $tester->upload(\%arg);
#pod
#pod Required arguments are:
#pod
#pod   accountId - the account for which we're uploading (no default)
#pod   type      - the content-type we want to provide to the server
#pod   blob      - the data to upload. Must be a reference to a string
#pod
#pod This uploads the given blob.
#pod
#pod The return value will either be a L
#pod object|JMAP::Tester::Result::Failure> or an L
#pod result|JMAP::Tester::Result::Upload>.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the Result.
#pod
#pod =cut

sub upload ($self, $arg) {
  # TODO: support blob as handle or sub -- rjbs, 2016-11-17

  my $uri = $self->upload_uri;

  Carp::confess("can't upload without upload_uri")
    unless $uri;

  for my $param (qw(accountId type blob)) {
    my $value = $arg->{ $param };

    Carp::confess("missing required parameter $param")
      unless defined $value;

    if ($param eq 'accountId') {
      $uri =~ s/\{$param\}/$value/g;
    }
  }

  my $post = HTTP::Request->new(
    POST => $uri,
    [
      'Content-Type' => $arg->{type},
      $self->_maybe_auth_header,
    ],
    ${ $arg->{blob} },
  );

  my $res_f = $self->ua->request($self, $post, 'upload');

  my $future = $res_f->then(sub {
    my ($res) = @_;

    unless ($res->is_success) {
      $self->_logger->log_upload_response($self, { http_response => $res });
      return Future->fail(
        JMAP::Tester::Result::Failure->new({
          http_response => $res,
          diagnostic_dumper => $self->default_diagnostic_dumper,
        })
      );
    }

    my $json = $res->decoded_content;
    my $blob = $self->apply_json_types( $self->json_decode( $json ) );

    $self->_logger->log_upload_response(
      $self,
      {
        json          => $json,
        blob_struct   => $blob,
        http_response => $res,
      }
    );

    return Future->done(
      JMAP::Tester::Result::Upload->new({
        http_response => $res,
        payload       => $blob,
        diagnostic_dumper => $self->default_diagnostic_dumper,
      })
    );
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

#pod =method download
#pod
#pod   my $result = $tester->download(\%uri_arg, \%other_arg);
#pod
#pod The first hashref provides values that go into the download URI:
#pod
#pod   blobId    - the blob to download (no default)
#pod   accountId - the account for which we're downloading (no default)
#pod   type      - the content-type we want the server to provide back (no default)
#pod   name      - the name we want the server to provide back (default: "download")
#pod
#pod If the download URI template has a C, C, or C
#pod placeholder but no argument for that is given to C, an exception
#pod will be thrown.
#pod
#pod The second hashref, which is optional, provides other arguments to the method.
#pod Right now, there is only one, B.  The argument is only here
#pod for legacy purposes, specifically for the Cyrus IMAP project, and may be
#pod removed B.
#pod
#pod   accept    - the value of the Accept header to use when downloading
#pod
#pod The return value will either be a L
#pod object|JMAP::Tester::Result::Failure> or an L
#pod result|JMAP::Tester::Result::Download>.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the Result.
#pod
#pod =cut

my %DL_DEFAULT = (name => 'download');

sub _jwt_sub_param_from_uri ($self, $to_sign) {
  "$to_sign";
}

sub download_uri_for ($self, $arg) {
  Carp::confess("can't compute download URI without configured download_uri")
    unless my $uri = $self->download_uri;

  for my $param (qw(blobId accountId name type)) {
    next unless $uri =~ /\{$param\}/;
    my $value = $arg->{ $param } // $DL_DEFAULT{ $param };

    Carp::confess("missing required template parameter $param")
      unless defined $value;

    if ($param eq 'name') {
      $value = uri_escape($value);
    }

    $uri =~ s/\{$param\}/$value/g;
  }

  if (my $jwtc = $self->_get_jwt_config) {
    my $to_get  = URI->new($uri);
    my $to_sign = $to_get->clone->canonical;

    $to_sign->query(undef);

    my $header = encode_b64u( $self->json_encode({
      alg => 'HS256',
      typ => 'JWT',
    }) );

    my $iat = time;
    $iat = $iat - ($iat % 3600);

    my $payload = encode_b64u( $self->json_encode({
      iss => $jwtc->{signingId},
      iat => $iat,
      sub => $self->_jwt_sub_param_from_uri($to_sign),
    }) );

    my $signature = hmac_b64u(
      'SHA256',
      decode_b64u($jwtc->{signingKey}),
      "$header.$payload",
    );

    $to_get->query_param(access_token => "$header.$payload.$signature");
    $uri = "$to_get";
  }

  return $uri;
}

sub download ($self, $uri_arg, $arg = undef) {
  $arg //= {};

  my $uri = $self->download_uri_for($uri_arg);

  my $get = HTTP::Request->new(
    GET => $uri,
    [
      $self->_maybe_auth_header,
      ($arg->{accept} ? (Accept => $arg->{accept}) : ()),
    ],
  );

  my $res_f = $self->ua->request($self, $get, 'download');

  my $future = $res_f->then(sub {
    my ($res) = @_;

    $self->_logger->log_download_response($self, { http_response => $res });

    unless ($res->is_success) {
      return Future->fail(
        JMAP::Tester::Result::Failure->new({
          http_response => $res,
          diagnostic_dumper => $self->default_diagnostic_dumper,
        })
      );
    }

    return Future->done(
      JMAP::Tester::Result::Download->new({
        http_response => $res,
        diagnostic_dumper => $self->default_diagnostic_dumper,
      })
    );
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

sub _maybe_auth_header ($self) {
  return ($self->_access_token
          ? (Authorization => "Bearer " . $self->_access_token)
          : ());
}

has _jwt_config => (
  is => 'rw',
  init_arg => undef,
);

sub _now_timestamp {
  #   0     1     2      3      4     5
  my ($sec, $min, $hour, $mday, $mon, $year) = gmtime;
  return sprintf '%04u-%02u-%02uT%02u:%02u:%02uZ',
    $year + 1900, $mon + 1, $mday,
    $hour, $min, $sec;
}

sub _get_jwt_config ($self) {
  return unless my $jwtc = $self->_jwt_config;
  return $jwtc unless $jwtc->{signingKeyValidUntil};
  return $jwtc if $jwtc->{signingKeyValidUntil} gt $self->_now_timestamp;

  $self->update_client_session;
  return unless $jwtc = $self->_jwt_config;
  return $jwtc;
}

has _access_token => (
  is  => 'rw',
  init_arg => undef,
);

#pod =method get_client_session
#pod
#pod   $tester->get_client_session;
#pod   $tester->get_client_session($auth_uri);
#pod
#pod This method fetches the content at the authentication endpoint.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the L object.
#pod
#pod =cut

sub _get_client_session_future ($self, $auth_uri = undef) {
  $auth_uri //= $self->authentication_uri;

  my $auth_req = HTTP::Request->new(
    GET => $auth_uri,
    [
      $self->_maybe_auth_header,
      'Accept' => 'application/json',
    ],
  );

  my $future = $self->ua->request($self, $auth_req, 'auth')->then(sub {
    my ($res) = @_;

    unless ($res->code == 200) {
      return Future->fail(
        JMAP::Tester::Result::Failure->new({
          ident         => 'failure to get updated authentication data',
          http_response => $res,
          diagnostic_dumper => $self->default_diagnostic_dumper,
        })
      );
    }

    my $client_session = $self->json_decode( $res->decoded_content );

    my $auth = JMAP::Tester::Result::Auth->new({
      http_response   => $res,
      client_session  => $client_session,
      diagnostic_dumper => $self->default_diagnostic_dumper,
    });

    return Future->done($auth);
  });
}

sub get_client_session ($self, $auth_uri = undef) {
  my $future = $self->_get_client_session_future($auth_uri);
  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

#pod =method update_client_session
#pod
#pod   $tester->update_client_session;
#pod   $tester->update_client_session($auth_uri);
#pod
#pod This method fetches the content at the authentication endpoint and uses it to
#pod configure the tester's target URIs and signing keys.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the Result.
#pod
#pod =cut

sub update_client_session ($self, $auth_uri = undef) {
  my $future = $self->_get_client_session_future($auth_uri)->then(sub {
    my ($auth) = @_;

    $self->configure_from_client_session($auth->client_session);

    return Future->done($auth);
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

#pod =method configure_from_client_session
#pod
#pod   $tester->configure_from_client_session($client_session);
#pod
#pod Given a client session object (like those stored in an Auth result), this
#pod reconfigures the testers access token, signing keys, URIs, and so forth.  This
#pod method is used internally when logging in.
#pod
#pod =cut

sub configure_from_client_session ($self, $client_session) {
  # It's not crazy to think that we'd also try to pull the primary accountId
  # out of the accounts in the auth struct, but I don't think there's a lot to
  # gain by doing that yet.  Maybe later we'd use it to set the default
  # X-JMAP-AccountId or other things, but I think there are too many open
  # questions.  I'm leaving it out on purpose for now. -- rjbs, 2016-11-18

  # This is no longer fatal because you might be an anonymous session that
  # needs to call this to fetch an updated signing key. -- rjbs, 2017-03-23
  # abort("no accessToken in client session object")
  #  unless $client_session->{accessToken};

  $self->_access_token($client_session->{accessToken});

  if ($client_session->{signingId} && $client_session->{signingKey}) {
    $self->_jwt_config({
      signingId   => $client_session->{signingId},
      signingKey  => $client_session->{signingKey},
      signingKeyValidUntil => $client_session->{signingKeyValidUntil},
    });
  } else {
    $self->_jwt_config(undef);
  }

  for my $type (qw(api download upload)) {
    if (defined (my $uri = $client_session->{"${type}Url"})) {
      my $setter = "$type\_uri";
      $self->$setter($uri);
    } else {
      my $clearer = "clear_$type\_uri";
      $self->$clearer;
    }
  }

  $self->_primary_accounts($client_session->{primaryAccounts});
  $self->_accounts($client_session->{accounts});

  return;
}

#pod =method logout
#pod
#pod   $tester->logout;
#pod
#pod This method attempts to log out from the server by sending a C request
#pod to the authentication URI.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the Result.
#pod
#pod =cut

sub logout ($self) {
  # This is fatal, not a failure return, because it reflects the user screwing
  # up, not a possible JMAP-related condition. -- rjbs, 2017-02-10
  Carp::confess("can't logout: no authentication_uri configured")
    unless $self->has_authentication_uri;

  my $req = HTTP::Request->new(
    DELETE => $self->authentication_uri,
    [
      'Content-Type' => 'application/json; charset=utf-8',
      'Accept'       => 'application/json',
    ],
  );

  my $future = $self->ua->request($self, $req, 'auth')->then(sub {
    my ($res) = @_;

    if ($res->code == 204) {
      $self->_access_token(undef);

      return Future->done(
        JMAP::Tester::Result::Logout->new({
          http_response => $res,
        })
      );
    }

    return Future->fail(
      JMAP::Tester::Result::Failure->new({
        ident => "failed to log out",
        http_response => $res,
        diagnostic_dumper => $self->default_diagnostic_dumper,
      })
    );
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

#pod =method http_request
#pod
#pod   my $response = $jtest->http_request($http_request);
#pod
#pod Sometimes, you may need to make an HTTP request with your existing web
#pod connection.  This might be to interact with a custom authentication mechanism,
#pod to access custom endpoints, or just to make very, very specifically crafted
#pod requests.  For this reasons, C exists.
#pod
#pod Pass this method an L and it will use the tester's UA object to
#pod make the request.
#pod
#pod This method respects the C attributes of the
#pod JMAP::Tester object, and in futures mode will return a future that will resolve
#pod to the L.
#pod
#pod =cut

sub http_request ($self, $http_request) {
  my $future = $self->ua->request($self, $http_request, 'misc')->then(sub {
    my ($res) = @_;
    $self->_logger->log_misc_response($self, { http_response => $res });
    return Future->done($res);
  });

  return $self->should_return_futures ? $future : $future->$Failsafe->get;
}

#pod =method http_get
#pod
#pod   my $response = $jtest->http_get($url, $headers);
#pod
#pod This method is just sugar for calling C to make a GET request for
#pod the given URL.  C<$headers> is an optional arrayref of headers.
#pod
#pod =cut

sub http_get ($self, $url, $headers = undef) {
  my $req = HTTP::Request->new(
    GET => $url,
    (defined $headers ? $headers : ()),
  );
  return $self->http_request($req);
}

#pod =method http_post
#pod
#pod   my $response = $jtest->http_post($url, $body, $headers);
#pod
#pod This method is just sugar for calling C to make a POST request
#pod for the given URL.  C<$headers> is an arrayref of headers and C<$body> is the
#pod byte string to be passed as the body.
#pod
#pod =cut

sub http_post ($self, $url, $body, $headers = undef) {
  my $req = HTTP::Request->new(
    POST => $url,
    $headers // [],
    $body,
  );

  return $self->http_request($req);
}

has default_diagnostic_dumper => (
  is => 'ro',
  default => sub {
    require JSON::MaybeXS;
    state $json = JSON::MaybeXS->new->utf8->convert_blessed->pretty->canonical;
    sub ($value) { $json->encode($value); }
  },
);

1;

__END__