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 use namespace::clean;
  11
  12 our $VERSION = '999.999'; # VERSION
  13
  14 sub _croak { require Carp; goto &Carp::croak }
  15
  16 sub new {
  17     my $class = shift;
  18     my $self  = @_ % 2 == 0 ? {@_} : $_[0];
  19     bless $self, $class;
  20 }
  21
  22 sub execute {
  23     my $self = shift;
  24     my ($request, $options) = @_;
  25
  26     my $url     = delete $options->{url}    || $self->url;
  27     my $method  = delete $options->{method} || $self->method;
  28
  29     $request && ref($request) eq 'HASH' or _croak q{Usage: $http->execute(\%request)};
  30     $request->{query} or _croak q{Request must have a query};
  31     $url or _croak q{URL must be provided};
  32
  33     my $data = {%$request};
  34
  35     if ($method eq 'GET' || $method eq 'HEAD') {
  36         $data->{variables} = $self->json->encode($data->{variables}) if $data->{variables};
  37         my $params  = www_form_urlencode($data);
  38         my $sep     = $url =~ /^[^#]+\?/ ? '&' : '?';
  39         $url =~ s/#/${sep}${params}#/ or $url .= "${sep}${params}";
  40     }
  41     else {
  42         my $encoded_data = $self->json->encode($data);
  43         $options->{content} = $encoded_data;
  44         $options->{headers}{'content-length'} = length $encoded_data;
  45         $options->{headers}{'content-type'}   = 'application/json;charset=UTF-8';
  46     }
  47
  48     return $self->_handle_response($self->any_ua->request($method, $url, $options));
  49 }
  50
  51 sub _handle_response {
  52     my $self = shift;
  53     my ($resp) = @_;
  54
  55     if (eval { $resp->isa('Future') }) {
  56         return $resp->followed_by(sub {
  57             my $f = shift;
  58
  59             if (my ($exception, $category, @other) = $f->failure) {
  60                 if (ref $exception eq 'HASH') {
  61                     my $resp = $exception;
  62                     return Future->done($self->_handle_error($resp));
  63                 }
  64
  65                 return Future->done({
  66                     error       => $exception,
  67                     response    => undef,
  68                     details     => {
  69                         exception_details => [$category, @other],
  70                     },
  71                 });
  72             }
  73
  74             my $resp = $f->get;
  75             return Future->done($self->_handle_success($resp));
  76         });
  77     }
  78     else {
  79         return $self->_handle_error($resp) if !$resp->{success};
  80         return $self->_handle_success($resp);
  81     }
  82 }
  83
  84 sub _handle_error {
  85     my $self = shift;
  86     my ($resp) = @_;
  87
  88     my $data    = eval { $self->json->decode($resp->{content}) };
  89     my $content = $resp->{content} // 'No content';
  90     my $reason  = $resp->{reason}  // '';
  91     my $message = "HTTP transport returned $resp->{status} ($reason): $content";
  92
  93     chomp $message;
  94
  95     return {
  96         error       => $message,
  97         response    => $data,
  98         details     => {
  99             http_response   => $resp,
 100         },
 101     };
 102 }
 103
 104 sub _handle_success {
 105     my $self = shift;
 106     my ($resp) = @_;
 107
 108     my $data = eval { $self->json->decode($resp->{content}) };
 109     if (my $exception = $@) {
 110         return {
 111             error       => "HTTP transport failed to decode response: $exception",
 112             response    => undef,
 113             details     => {
 114                 http_response   => $resp,
 115             },
 116         };
 117     }
 118
 119     return {
 120         response    => $data,
 121         details     => {
 122             http_response   => $resp,
 123         },
 124     };
 125 }
 126
 127 sub ua {
 128     my $self = shift;
 129     $self->{ua} //= do {
 130         require HTTP::Tiny;
 131         HTTP::Tiny->new(
 132             agent => $ENV{GRAPHQL_CLIENT_HTTP_USER_AGENT} // "perl-graphql-client/$VERSION",
 133         );
 134     };
 135 }
 136
 137 sub any_ua {
 138     my $self = shift;
 139     $self->{any_ua} //= HTTP::AnyUA->new(ua => $self->ua);
 140 }
 141
 142 sub url {
 143     my $self = shift;
 144     $self->{url};
 145 }
 146
 147 sub method {
 148     my $self = shift;
 149     $self->{method} // 'POST';
 150 }
 151
 152 sub json {
 153     my $self = shift;
 154     $self->{json} //= do {
 155         require JSON::MaybeXS;
 156         JSON::MaybeXS->new(utf8 => 1);
 157     };
 158 }
 159
 160 1;
 161 __END__
 162
 163 =head1 SYNOPSIS
 164
 165     my $transport = GraphQL::Client::http->new(
 166         url     => 'http://localhost:5000/graphql',
 167         method  => 'POST',
 168     );
 169
 170     my $request = {
 171         query           => 'query Greet($name: String) { hello(name: $name) }',
 172         operationName   => 'Greet',
 173         variables       => { name => 'Bob' },
 174     };
 175     my $options = {
 176         headers => {
 177             authorization => 'Bearer s3cr3t',
 178         },
 179     };
 180     my $response = $transport->execute($request, $options);
 181
 182 =head1 DESCRIPTION
 183
 184 You probably shouldn't use this directly. Instead use L<GraphQL::Client>.
 185
 186 C<GraphQL::Client::http> is a GraphQL transport for HTTP. GraphQL is not required to be transported
 187 via HTTP, but this is definitely the most common way.
 188
 189 This also serves as a reference implementation for C<GraphQL::Client> transports.
 190
 191 =method new
 192
 193     $transport = GraphQL::Client::http->new(%attributes);
 194
 195 Construct a new GraphQL HTTP transport.
 196
 197 See L</ATTRIBUTES>.
 198
 199 =method execute
 200
 201     $response = $client->execute(\%request);
 202     $response = $client->execute(\%request, \%options);
 203
 204 Get a response from the GraphQL server.
 205
 206 The C<%request> structure must have a C<query> key whose value is the query or mutation string. It
 207 may optionally have a C<variables> hashref and an C<operationName> string.
 208
 209 The C<%options> structure is optional and may contain options passed through to the user agent. The
 210 only useful options are C<headers> (which should have a hashref value) and C<method> and C<url> to
 211 override the attributes of the same names.
 212
 213 The response will either be a hashref with the following structure or a L<Future> that resolves to
 214 such a hashref:
 215
 216     {
 217         response    => {    # decoded response (may be undef if an error occurred)
 218             data   => {...},
 219             errors => [...],
 220         },
 221         error       => 'Something happened',    # omitted if no error occurred
 222         details     => {    # optional information which may aide troubleshooting
 223         },
 224     }
 225
 226 =attr ua
 227
 228 A user agent, such as:
 229
 230 =for :list
 231 * instance of a L<HTTP::Tiny> (this is the default if no user agent is provided)
 232 * instance of a L<Mojo::UserAgent>
 233 * the string C<"AnyEvent::HTTP">
 234 * and more...
 235
 236 See L<HTTP::AnyUA/"SUPPORTED USER AGENTS">.
 237
 238 =attr any_ua
 239
 240 The L<HTTP::AnyUA> instance. Can be used to apply middleware if desired.
 241
 242 =attr url
 243
 244 The http URL of a GraphQL endpoint, e.g. C<"http://myapiserver/graphql">.
 245
 246 =attr method
 247
 248 The HTTP method to use when querying the GraphQL server. Can be one of:
 249
 250 =for :list
 251 * C<GET>
 252 * C<POST> (default)
 253
 254 GraphQL servers should be able to handle both, but you can set this explicitly to one or the other
 255 if you're dealing with a server that is opinionated. You can also provide a different HTTP method,
 256 but anything other than C<GET> and C<POST> are less likely to work.
 257
 258 =attr json
 259
 260 The L<JSON::XS> (or compatible) object used for encoding and decoding data structures to and from
 261 the GraphQL server.
 262
 263 Defaults to a L<JSON::MaybeXS>.
 264
 265 =head1 SEE ALSO
 266
 267 L<https://graphql.org/learn/serving-over-http/>
 268