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 = '0.604'; # 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
 162 __END__
 163
 164 =pod
 165
 166 =encoding UTF-8
 167
 168 =head1 NAME
 169
 170 GraphQL::Client::http - GraphQL over HTTP
 171
 172 =head1 VERSION
 173
 174 version 0.604
 175
 176 =head1 SYNOPSIS
 177
 178     my $transport = GraphQL::Client::http->new(
 179         url     => 'http://localhost:5000/graphql',
 180         method  => 'POST',
 181     );
 182
 183     my $request = {
 184         query           => 'query Greet($name: String) { hello(name: $name) }',
 185         operationName   => 'Greet',
 186         variables       => { name => 'Bob' },
 187     };
 188     my $options = {
 189         headers => {
 190             authorization => 'Bearer s3cr3t',
 191         },
 192     };
 193     my $response = $transport->execute($request, $options);
 194
 195 =head1 DESCRIPTION
 196
 197 You probably shouldn't use this directly. Instead use L<GraphQL::Client>.
 198
 199 C<GraphQL::Client::http> is a GraphQL transport for HTTP. GraphQL is not required to be transported
 200 via HTTP, but this is definitely the most common way.
 201
 202 This also serves as a reference implementation for C<GraphQL::Client> transports.
 203
 204 =head1 ATTRIBUTES
 205
 206 =head2 ua
 207
 208 A user agent, such as:
 209
 210 =over 4
 211
 212 =item *
 213
 214 instance of a L<HTTP::Tiny> (this is the default if no user agent is provided)
 215
 216 =item *
 217
 218 instance of a L<Mojo::UserAgent>
 219
 220 =item *
 221
 222 the string C<"AnyEvent::HTTP">
 223
 224 =item *
 225
 226 and more...
 227
 228 =back
 229
 230 See L<HTTP::AnyUA/"SUPPORTED USER AGENTS">.
 231
 232 =head2 any_ua
 233
 234 The L<HTTP::AnyUA> instance. Can be used to apply middleware if desired.
 235
 236 =head2 url
 237
 238 The http URL of a GraphQL endpoint, e.g. C<"http://myapiserver/graphql">.
 239
 240 =head2 method
 241
 242 The HTTP method to use when querying the GraphQL server. Can be one of:
 243
 244 =over 4
 245
 246 =item *
 247
 248 C<GET>
 249
 250 =item *
 251
 252 C<POST> (default)
 253
 254 =back
 255
 256 GraphQL servers should be able to handle both, but you can set this explicitly to one or the other
 257 if you're dealing with a server that is opinionated. You can also provide a different HTTP method,
 258 but anything other than C<GET> and C<POST> are less likely to work.
 259
 260 =head2 json
 261
 262 The L<JSON::XS> (or compatible) object used for encoding and decoding data structures to and from
 263 the GraphQL server.
 264
 265 Defaults to a L<JSON::MaybeXS>.
 266
 267 =head1 METHODS
 268
 269 =head2 new
 270
 271     $transport = GraphQL::Client::http->new(%attributes);
 272
 273 Construct a new GraphQL HTTP transport.
 274
 275 See L</ATTRIBUTES>.
 276
 277 =head2 execute
 278
 279     $response = $client->execute(\%request);
 280     $response = $client->execute(\%request, \%options);
 281
 282 Get a response from the GraphQL server.
 283
 284 The C<%request> structure must have a C<query> key whose value is the query or mutation string. It
 285 may optionally have a C<variables> hashref and an C<operationName> string.
 286
 287 The C<%options> structure is optional and may contain options passed through to the user agent. The
 288 only useful options are C<headers> (which should have a hashref value) and C<method> and C<url> to
 289 override the attributes of the same names.
 290
 291 The response will either be a hashref with the following structure or a L<Future> that resolves to
 292 such a hashref:
 293
 294     {
 295         response    => {    # decoded response (may be undef if an error occurred)
 296             data   => {...},
 297             errors => [...],
 298         },
 299         error       => 'Something happened',    # omitted if no error occurred
 300         details     => {    # optional information which may aide troubleshooting
 301         },
 302     }
 303
 304 =head1 SEE ALSO
 305
 306 L<https://graphql.org/learn/serving-over-http/>
 307
 308 =head1 BUGS
 309
 310 Please report any bugs or feature requests on the bugtracker website
 311 L<https://github.com/chazmcgarvey/graphql-client/issues>
 312
 313 When submitting a bug or request, please include a test-file or a
 314 patch to an existing test-file that illustrates the bug or desired
 315 feature.
 316
 317 =head1 AUTHOR
 318
 319 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 320
 321 =head1 COPYRIGHT AND LICENSE
 322
 323 This software is copyright (c) 2020 by Charles McGarvey.
 324
 325 This is free software; you can redistribute it and/or modify it under
 326 the same terms as the Perl 5 programming language system itself.
 327
 328 =cut