Dogcows Code - chaz/graphql-client/blob - lib/GraphQL/Client/http.pm

   1 package GraphQL::Client::http;
   2 # ABSTRACT: GraphQL over HTTP
   3
   4 use 5.010;
   5 use warnings;
   6 use strict;
   7
   8 use HTTP::AnyUA::Util qw(www_form_urlencode);
   9 use HTTP::AnyUA;
  10
  11 our $VERSION = '999.999'; # VERSION
  12
  13 sub new {
  14     my $class = shift;
  15     bless {@_}, $class;
  16 }
  17
  18 sub request {
  19     my $self = shift;
  20     my ($request, $options) = @_;
  21
  22     my $url     = delete $options->{url}    || $self->url;
  23     my $method  = delete $options->{method} || $self->method;
  24
  25     my $data = {%$request};
  26
  27     if ($method eq 'GET' || $method eq 'HEAD') {
  28         $data->{variables} = $self->json->encode($data->{variables}) if $data->{variables};
  29         my $params  = www_form_urlencode($data);
  30         my $sep     = $url =~ /\?/ ? '&' : '?';
  31         $url .= "${sep}${params}";
  32     }
  33     else {
  34         my $encoded_data = $self->json->encode($data);
  35         $options->{content} = $encoded_data;
  36         $options->{headers}{'content-length'} = length $encoded_data;
  37         $options->{headers}{'content-type'}   = 'application/json';
  38     }
  39
  40     return $self->_handle_response($self->any_ua->request($method, $url, $options));
  41 }
  42
  43 sub _handle_response {
  44     my $self = shift;
  45     my ($resp) = @_;
  46
  47     my $handle_error = sub {
  48         my $resp = shift;
  49
  50         my $data = eval { $self->json->decode($resp->{content}) };
  51         if ($@) {
  52             my $content = $resp->{content} // 'No content';
  53             my $reason  = $resp->{reason}  // '';
  54             $data = {
  55                 errors => [
  56                     {
  57                         message => "HTTP transport returned $resp->{status} ($reason): $content",
  58                     },
  59                 ],
  60             };
  61         }
  62
  63         return ($data, 'graphql', $resp);
  64     };
  65     my $handle_response = sub {
  66         my $resp = shift;
  67
  68         return $handle_error->($resp) if !$resp->{success};
  69         my $data = eval { $self->json->decode($resp->{content}) };
  70         if (my $err = $@) {
  71             warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
  72             $data = {
  73                 errors => [
  74                     {
  75                         message => 'HTTP transport failed to decode response from GraphQL server.',
  76                     },
  77                 ],
  78             };
  79         }
  80         return $data;
  81     };
  82
  83     if ($self->any_ua->response_is_future) {
  84         return $resp->transform(
  85             done => $handle_response,
  86             fail => $handle_error,
  87         );
  88     }
  89     else {
  90         return $handle_response->($resp);
  91     }
  92 }
  93
  94 sub ua {
  95     my $self = shift;
  96     $self->{ua} //= do {
  97         require HTTP::Tiny;
  98         HTTP::Tiny->new(
  99             agent   => "perl-graphql-client/$VERSION",
 100         );
 101     };
 102 }
 103
 104 sub any_ua {
 105     my $self = shift;
 106     $self->{any_ua} //= HTTP::AnyUA->new(ua => $self->ua);
 107 }
 108
 109 sub url {
 110     my $self = shift;
 111     $self->{url};
 112 }
 113
 114 sub method {
 115     my $self = shift;
 116     $self->{method} // 'POST';
 117 }
 118
 119 sub json {
 120     my $self = shift;
 121     $self->{json} //= do {
 122         require JSON::MaybeXS;
 123         JSON::MaybeXS->new(utf8 => 1);
 124     };
 125 }
 126
 127 1;
 128 __END__
 129
 130 =head1 SYNOPSIS
 131
 132     my $transport = GraphQL::Client::http->new(
 133         url     => 'http://localhost:5000/graphql',
 134         method  => 'POST',
 135     );
 136
 137     my $data = $client->request($query, $variables, $operation_name, $options);
 138
 139 =head1 DESCRIPTION
 140
 141 You probably shouldn't use this directly. Instead use L<GraphQL::Client>.
 142
 143 C<GraphQL::Client::http> is a GraphQL transport for HTTP. GraphQL is not required to be transported
 144 via HTTP, but this is definitely the most common way.
 145
 146 This also serves as a reference implementation for future GraphQL transports.
 147
 148 =method new
 149
 150     $transport = GraphQL::Client::http->new(%attributes);
 151
 152 Construct a new GraphQL HTTP transport.
 153
 154 =method request
 155
 156     $response = $client->request(\%data, \%options);
 157
 158 Get a response from the GraphQL server.
 159
 160 The C<%data> structure must have a C<query> key whose value is the query or mutation string. It may
 161 optionally have a C<variables> hashref an an C<operationName> string.
 162
 163 The C<%options> structure contains options passed through to the user agent.
 164
 165 The response will either be a hashref with the following structure or a L<Future> that resolves to
 166 such a hashref:
 167
 168     {
 169         data   => {...},
 170         errors => [...],
 171     }
 172
 173 =attr ua
 174
 175 A user agent, such as:
 176
 177 =for :list
 178 * instance of a L<HTTP::Tiny> (this is the default if no user agent is provided)
 179 * instance of a L<Mojo::UserAgent>
 180 * the string C<"AnyEvent::HTTP">
 181 * and more...
 182
 183 See L<HTTP::AnyUA/"SUPPORTED USER AGENTS">.
 184
 185 =attr any_ua
 186
 187 The L<HTTP::AnyUA> instance. Can be used to apply middleware if desired.
 188
 189 =attr method
 190
 191 The HTTP method to use when querying the GraphQL server. Can be one of:
 192
 193 =for :list
 194 * C<GET>
 195 * C<POST> (default)
 196
 197 =attr json
 198
 199 The L<JSON::XS> (or compatible) object used for encoding and decoding data structures to and from
 200 the GraphQL server.
 201
 202 Defaults to a L<JSON::MaybeXS>.
 203
 204 =head1 SEE ALSO
 205
 206 L<https://graphql.org/learn/serving-over-http/>
 207