view release on metacpan or  search on metacpan

lib/App/MatrixTool/HTTPClient.pm  view on Meta::CPAN

=cut

sub resolve_addr
{
   my $self = shift;
   my ( $host ) = @_;

   $self->{resolver}->getaddrinfo(
      host     => $host,
      service  => "",
      family   => $self->{family},
      socktype => SOCK_RAW,
   )->then( sub {
      my @res = @_;
      return Future->done(
         map { ( getnameinfo( $_->{addr}, NI_NUMERICHOST ) )[1] } @res
      );
   });
}

=head2 request

   $response = $client->request( server => $name, method => $method, path => $path, ... )->get

Performs an HTTPS request to the given server, by resolving the server name
using the C<resolve_matrix> method first, thus obeying its published C<SRV>
records.

=cut

sub request
{
   my $self = shift;
   my %params = @_;

   my $uri = URI->new;
   $uri->path( $params{path} );
   $uri->query_form( %{ $params{params} } ) if $params{params};

   my $ua  = $self->ua;
   my $req = $params{request} // HTTP::Request->new( $params{method} => $uri,
      [ Host => $params{server} ],
   );
   $req->protocol( "HTTP/1.1" );

   if( defined $params{content} ) {
      if( ref $params{content} ) {
         $req->content( encode_json( delete $params{content} ) );
         $req->header( Content_type => "application/json" );
      }
      else {
         $req->content( delete $params{content} );
         $req->header( Content_type => delete $params{content_type} //
            croak "Non-reference content needs 'content_type'" );
      }
      $req->header( Content_length => length $req->content );
   }

   if( $self->{print_request} ) {
      print STDERR "Sending HTTP request to $params{server}\n";
      print STDERR "  $_\n" for split m/\n/, $req->as_string( "\n" );
   }

   my $path = $req->uri->path;

   # Different kinds of request need resolving either as a client or as a
   # federated server
   my $resolve_f;
   if( $path =~ m{^/_matrix/key/} ) {
      $resolve_f = $self->resolve_matrix( $params{server} )->then( sub {
         my @res = @_;
         Future->done( map {
            { SSL => 1, host => $_->{target}, port => $_->{port}, family => $self->{family} }
         } @res );
      });
   }
   elsif( $path =~ m{^/_matrix/(?:client|media)/} ) {
      my ( $server, $port ) = $params{server} =~ m/^([^:]+)(?::(\d+))?$/ or
         die "Unable to parse server '$params{server}'\n";
      $resolve_f = Future->done(
         { SSL => 1, port => $port // 443, host => $server, family => $self->{family} }
      );
   }
   else {
      die "Unsure how to resolve server for path $path\n";
   }

   $resolve_f->then( sub {
      my @res = @_;

      repeat_until_success {
         my $res = shift;
         print STDERR "Using target $res->{host} port $res->{port}\n" if $self->{print_request};

         $ua->do_request(
            %params,
            %$res,
            request => $req,
         )->on_done( sub {
            my ( $response ) = @_;
            if( $self->{print_response} ) {
               print STDERR "Received HTTP response:\n";
               print STDERR "  $_\n" for split m/\n/, $response->as_string( "\n" );
            }
         })->on_fail( sub {
            my ( undef, $name, $response ) = @_;
            if( $name eq "http" and $self->{print_response} ) {
               print STDERR "Received HTTP response:\n";
               print STDERR "  $_\n" for split m/\n/, $response->as_string( "\n" );
            }
         });
      } foreach => \@res;
   });
}

=head2 request_json

   ( $body, $response ) = $client->request_json( ... )

A small wrapper around C<request> that decodes the returned body as JSON.

=cut

sub request_json
{
   my $self = shift;
   $self->request( @_ )->then( sub {
      my ( $response ) = @_;

      $response->content_type eq "application/json" or
         return Future->fail( "Expected an application/json response body", matrix => );

      Future->done( decode_json( $response->decoded_content ), $response );
   });
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;