view release on metacpan or  search on metacpan

t/29_imap_oauth.t  view on Meta::CPAN

{
   no warnings "redefine";
   local *AnyEvent::HTTP::http_request = sub {
      my ($method, $endpoint, @args) = @_;
      my $cb = pop @args;
      my %args = @args;
      push @requests, [$method, $endpoint, \%args];
      my $body = $args{body};
      my $response = $body =~ /grant_type=authorization_code/
         ? '{"access_token":"first-access","refresh_token":"initial-refresh","token_type":"Bearer"}'
         : '{"access_token":"renewed-access","refresh_token":"rotated-refresh","token_type":"Bearer"}';
      $args{on_body}->($response, { Status => 200 });
      $cb->(undef, { Status => 200 });
      undef
   };

   my $granted = $oauth->can ("finish")->(\%kv, $state, $verifier, $redirect);
   is $granted->{access_token}, "first-access", "authorization code exchanged for access token";
   is $granted->{refresh_token}, "initial-refresh", "authorization code gets refresh token";
   is $requests[0][0], "POST", "token grant uses POST";
   is $requests[0][1], "https://login.example.org/token", "token grant uses configured endpoint";
   like $requests[0][2]{body}, qr/grant_type=authorization_code/, "authorization grant type";
   like $requests[0][2]{body}, qr/code_verifier=/, "PKCE verifier sent to token endpoint";
   like $requests[0][2]{body}, qr/client_secret=public-secret/, "client_secret_post configured";
   is $requests[0][2]{tls_ctx}, "high", "OAuth token HTTP uses verified TLS";
   is $requests[0][2]{recurse}, 0, "no redirect following for token endpoint";

   my $dir = tempdir (CLEANUP => 1);
   my $file = "$dir/account.ini";
   $kv{"oauth-refresh-token-base64"} = MIME::Base64::encode_base64 ("initial-refresh", "");
   my $lock = AnyEvent::MCP::File::lock $file;
   AnyEvent::MCP::File::replace $file, "[account]\n"
      . (join "", map "$_ = $kv{$_}\n", sort keys %kv);
   close $lock;

   is $oauth->can ("refresh")->($file, \%kv), "renewed-access", "refresh grant supplies access token";
   open my $fh, "<:raw", $file or die "$file: $!";
   my $saved = do { local $/; <$fh> };
   close $fh;
   like $saved, qr/oauth-refresh-token-base64 = /, "rotated refresh token persisted";
   unlike $saved, qr/initial-refresh|rotated-refresh|renewed-access/, "token values not persisted in cleartext";
   like $requests[1][2]{body}, qr/refresh_token=initial-refresh/, "refresh uses stored token";

   my $changed = { %kv, "oauth-client-id" => "other-client" };
   ok !eval { $oauth->can ("refresh")->($file, $changed); 1 },
      "reconnect refuses changed OAuth client registration";

   {
      local *AnyEvent::HTTP::http_request = sub {
         my ($method, $endpoint, @args) = @_;
         my $cb = pop @args;
         my %args = @args;
         push @requests, [$method, $endpoint, \%args];
         $args{on_body}->('{"access_token":"basic-access","token_type":"Bearer"}', { Status => 200 });
         $cb->(undef, { Status => 200 });
         undef
      };
      my %basic = (%kv, "oauth-client-auth" => "client_secret_basic");
      my $result = $oauth->can ("token")->(\%basic, grant_type => "refresh_token", refresh_token => "old");
      is $result->{access_token}, "basic-access", "client_secret_basic token response accepted";
      like $requests[-1][2]{headers}{Authorization}, qr/^Basic /, "basic client credentials sent in header";
      unlike $requests[-1][2]{body}, qr/client_secret/, "basic mode omits client secret from body";
   }

   {
      local *AnyEvent::HTTP::http_request = sub {
         my ($method, $endpoint, @args) = @_;
         my $cb = pop @args;
         my %args = @args;
         $args{on_body}->('{"error":"invalid_grant","error_description":"do not print secrets"}',
            { Status => 400 });
         $cb->(undef, { Status => 400 });
         undef
      };
      my $ok = eval { $oauth->can ("token")->(\%kv, grant_type => "refresh_token", refresh_token => "old"); 1 };
      ok !$ok, "failed token exchange rejects error response";
      like $@, qr/HTTP 400/, "token error identifies HTTP status";
      unlike $@, qr/do not print secrets/, "token error does not echo arbitrary provider error text";
   }

   {
      local *AnyEvent::HTTP::http_request = sub {
         my ($method, $endpoint, @args) = @_;
         my $cb = pop @args;
         my %args = @args;
         my $ok = $args{on_body}->("x" x 70000, { Status => 200 });
         $cb->(undef, { Status => $ok ? 200 : 598 });
         undef
      };
      my $ok = eval { $oauth->can ("token")->(\%kv, grant_type => "refresh_token", refresh_token => "old"); 1 };
      ok !$ok && $@ =~ /response too large/, "OAuth token response size is bounded";
   }
}

my $worker_tests = eval {
   require Mail::IMAPTalk;
   require IO::Socket::SSL;
   require Authen::SASL;
   require AnyEvent::MCP::Worker::IMAP;
   1
};
SKIP: {
   skip "optional IMAP worker dependencies not installed", 5 unless $worker_tests;

{
   package MockOAuthIMAP;
   our $sasl;
   sub new { bless {}, shift }
   sub capability { { "auth=xoauth2" => 1 } }
   sub authenticate {
      my ($self, $client) = @_;
      $sasl = $client->client_new ("imap", "imap.example.org")->client_start;
      1
   }
   sub uid { 1 }
   sub parse_mode { 1 }
   sub get_last_error { "fake auth error" }
}

{
   no warnings "redefine";