From 697f37637e11830cac0913e18aa7ebd41e6af508 Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Fri, 13 Mar 2020 23:47:08 -0600 Subject: [PATCH 1/1] initial commit --- .editorconfig | 20 +++ .gitignore | 13 ++ Changes | 5 + Makefile | 33 +++++ bin/graphql | 193 ++++++++++++++++++++++++++++ dist.ini | 7 + lib/GraphQL/Client.pm | 248 ++++++++++++++++++++++++++++++++++++ lib/GraphQL/Client/http.pm | 185 +++++++++++++++++++++++++++ lib/GraphQL/Client/https.pm | 21 +++ 9 files changed, 725 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 Changes create mode 100644 Makefile create mode 100755 bin/graphql create mode 100644 dist.ini create mode 100644 lib/GraphQL/Client.pm create mode 100644 lib/GraphQL/Client/http.pm create mode 100644 lib/GraphQL/Client/https.pm diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..e5c1fe1 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,20 @@ + +# Please follow these code style guidelines. You can use this file to +# automatically configure your editor. +# For instructions, see: http://editorconfig.org/ + +[*] +charset = utf8 +end_of_line = lf +insert_final_newline = true +trim_trailing_whitespace = true + +[{**.pl,**.pm,**.pod,**.t}] +indent_style = space +indent_size = 4 +max_line_length = 100 + +[{.editorconfig,**.ini}] +indent_style = space +indent_size = 4 + diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..eb4bee2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,13 @@ +*# +*.bs +*.o +*.tar* +*~ +/.build +/.perl-version +/GraphQL-Client-* +/MYMETA.* +/blib +/cover_db +/local* +/pm_to_blib diff --git a/Changes b/Changes new file mode 100644 index 0000000..d4835f5 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for GraphQL-Client. + +{{$NEXT}} + * Initial public release + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d12cda5 --- /dev/null +++ b/Makefile @@ -0,0 +1,33 @@ + +# This is not a Perl distribution, but it can build one using Dist::Zilla. + +COVER = cover +CPANM = cpanm +DZIL = dzil +PERL = perl +PROVE = prove + +all: dist + +bootstrap: + $(CPANM) $(CPANM_FLAGS) -n Dist::Zilla + $(DZIL) authordeps --missing |$(CPANM) $(CPANM_FLAGS) -n + $(DZIL) listdeps --develop --missing |$(CPANM) $(CPANM_FLAGS) -n + +clean: + $(DZIL) $@ + +cover: + $(COVER) -test + +dist: + $(DZIL) build + +distclean: clean + rm -rf cover_db + +test: + $(PROVE) -l$(if $(findstring 1,$(V)),v) t + +.PHONY: all bootstrap clean cover dist distclean test + diff --git a/bin/graphql b/bin/graphql new file mode 100755 index 0000000..071cac7 --- /dev/null +++ b/bin/graphql @@ -0,0 +1,193 @@ +#!/usr/bin/env perl +# PODNAME: graphql +# ABSTRACT: Command-line GraphQL client + +use warnings; +use strict; + +use Getopt::Long; +use GraphQL::Client; +use Scalar::Util qw(reftype); + +our $VERSION = '999.999'; # VERSION + +my $url; +my $transport = {}; +my $query = '-'; +my $variables = {}; +my $format = 'json:pretty'; +my $unpack = 0; +my $outfile; +GetOptions( + 'url|u=s' => \$url, + 'transport|t=s%' => \$transport, + 'query|mutation=s' => \$query, + 'variable|var|d=s%' => \$variables, + 'format|f=s' => \$format, + 'unpack!' => \$unpack, + 'output|o=s' => \$outfile, +) or die "Invalid options.\n"; + +$url = shift if !$url; +$query = shift if !$query || $query eq '-'; + +my $client = GraphQL::Client->new( + %$transport, + url => $url, +); +$client->transport; # just make sure we can load the transport + +if (!$query || $query eq '-') { + print STDERR "Interactive mode engaged! Waiting for a query on ...\n" if -t STDIN; + $query = do { local $/; <> }; +} + +my $resp = $client->request($query, $variables); +my $err = $resp->{errors}; +my $data = !$unpack || $err ? $resp : $resp->{data}; + +if ($outfile) { + open(my $out, '>', $outfile) or die "Open $outfile failed: $!"; + *STDOUT = $out; +} + +$format = lc($format); +if ($format eq 'json') { + require JSON::MaybeXS; + print JSON::MaybeXS->new(utf8 => 1)->encode($data); +} +elsif ($format eq 'json:pretty') { + require JSON::MaybeXS; + print JSON::MaybeXS->new(utf8 => 1, pretty => 1)->encode($data); +} +elsif ($format eq 'yaml') { + require YAML; + print YAML::Dump($data); +} +else { + require Data::Dumper; + print Data::Dumper::Dumper($data); +} + +exit($unpack && $err ? 1 : 0); + +=head1 SYNOPSIS + + graphql [--var key=value]... [--transport key=value]... + [--[no-]unpack] [--format json|json:pretty|yaml] + +=head1 DESCRIPTION + +C is a command-line program for executing queries and mutations on +a L server. + +=head1 OPTIONS + +=head2 --url STR + +The URL of the GraphQL server endpoint. + +If no C<--url> option is given, the first argument is assumed to be the URL. + +Alias: C<-u> + +=head2 --query STR + +The query or mutation to execute. + +If no C<--query> option is given, the first argument (after URL) is assumed to +be the query. + +If the value is C<-> (which is the default), the query will be read from +C. + +See: L + +Alias: C<--mutation> + +=head2 --variable KEY=VALUE + +A key-value pair + +See: L + +Aliases: C<--var>, C<-d> + +=head2 --transport KEY=VALUE + +Key-value pairs for configuring the transport (usually HTTP). + +Alias: C<-t> + +=head2 --unpack + +Enables C mode. + +By default, the response structure is printed as-is from the server, and the +program exits 0. + +When C mode is enabled, if the response completes with no errors, only +the data section of the response is printed and the program exits 0. If the +response has errors, the whole response structure is printed as-is and the +program exits 1. + +=head2 --format STR + +Sets the output format. Possible values include: + +=for :list +* C (default) +* C +* C +* C + +Alias: C<-f> + +=head1 EXAMPLES + +Different ways to provide the query/mutation: + + graphql http://localhost:4000/graphql {hello} + + echo {hello} | graphql http://localhost:4000/graphql + + graphql http://localhost:4000/graphql < {hello} + > END + + graphql http://localhost:4000/graphql + Interactive mode engaged! Waiting for a query on ... + {hello} + ^D + +This example shows the effect of L<--unpack>: + + graphql http://localhost:4000/graphql {hello} + + # Output: + { + "data" : { + "hello" : "Hello world!" + } + } + + graphql --unpack http://localhost:4000/graphql {hello} + + # Output: + { + "hello" : "Hello world!" + } + +Execute a query with variables: + + graphql unpack http://localhost:4000/graphql < query HeroNameAndFriends($episode: Episode) { + > hero(episode: $episode) { + > name + > friends { + > name + > } + > } + > } + > END + diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..3937ffe --- /dev/null +++ b/dist.ini @@ -0,0 +1,7 @@ +name = GraphQL-Client +author = Charles McGarvey +copyright_holder = Charles McGarvey +copyright_year = 2020 +license = Perl_5 + +[@Author::CCM] diff --git a/lib/GraphQL/Client.pm b/lib/GraphQL/Client.pm new file mode 100644 index 0000000..345fd28 --- /dev/null +++ b/lib/GraphQL/Client.pm @@ -0,0 +1,248 @@ +package GraphQL::Client; +# ABSTRACT: A GraphQL client + +use warnings; +use strict; + +use Module::Load qw(load); +use Throw; + +our $VERSION = '999.999'; # VERSION + +sub _croak { use Carp; goto &Carp::croak } + +sub new { + my $class = shift; + bless {@_}, $class; +} + +sub request { + my $self = shift; + my ($query, $variables, $options) = @_; + + my $transport_opts = {%{$options || {}}}; + my $operation_name = delete($transport_opts->{operation_name}) // delete($transport_opts->{operationName}); + + my $request = { + query => $query, + $variables ? (variables => $variables) : (), + $operation_name ? (operationName => $operation_name) : (), + }; + + my $resp = $self->transport->request($request, $transport_opts); + return $self->_handle_response($resp); +} + +sub _handle_response { + my $self = shift; + my ($resp) = @_; + + if (eval { $resp->isa('Future') }) { + return $resp->followed_by(sub { + my $f = shift; + if (my $exception = $f->failure) { + if ($self->unpack || !$exception->{errors}) { + return Future->fail($exception); + } + return Future->done($exception); + } + else { + my $resp = $f->get; + if ($self->unpack) { + if ($resp->{errors}) { + return Future->fail($resp); + } + return Future->done($resp->{data}); + } + return Future->done($resp); + } + }); + } + else { + if ($self->unpack) { + if ($resp->{errors}) { + throw 'The GraphQL server returned errors', { + %$resp, + type => 'graphql', + }; + } + return $resp->{data}; + } + return $resp; + } +} + +sub url { + my $self = shift; + $self->{url}; +} + +sub class { + my $self = shift; + $self->{class}; +} + +sub transport { + my $self = shift; + $self->{transport} //= do { + my $class = $self->_transport_class; + eval { load $class }; + if (my $err = $@) { + warn $err if $ENV{GRAPHQL_CLIENT_DEBUG}; + _croak "Failed to load transport for \"${class}\""; + } + $class->new(%$self); + }; +} + +sub unpack { + my $self = shift; + $self->{unpack} //= 0; +} + +sub _url_protocol { + my $self = shift; + + my $url = $self->url; + my ($protocol) = $url =~ /^([^+:]+)/; + + return $protocol; +} + +sub _transport_class { + my $self = shift; + + return _expand_class($self->{class}) if $self->{class}; + + my $protocol = $self->_url_protocol; + _croak 'Failed to determine transport from URL' if !$protocol; + + my $class = lc($protocol); + $class =~ s/[^a-z]/_/g; + + return _expand_class($class); +} + +sub _expand_class { + my $class = shift; + $class = "GraphQL::Client::$class" unless $class =~ s/^\+//; + $class; +} + +1; +__END__ + +=head1 SYNOPSIS + + my $client = GraphQL::Client->new(); + + my $data = $client->request(q[ + query GetHuman { + human(id: $human_id) { + name + height + } + } + ], { + human_id => 1000, + }); + +=head1 DESCRIPTION + +=method new + + $client = GraphQL::Client->new(%attributes); + +Construct a new client. + +=method request + + $response = $client->request($query); + $response = $client->request($query, \%variables); + $response = $client->request($query, \%variables, \%transport_options); + +Get a response from the GraphQL server. + +By default, the response will either be a hashref with the following structure or a L that +resolves to such a hashref, depending on the transport and how it is configured. + + { + data => { + field1 => {...}, # or [...] + ... + }, + errors => [ + { message => 'some error message blah blah blah' }, + ... + ], + } + +Note: Setting the L attribute affects the response shape. + +=attr url + +The URL of a GraphQL endpoint, e.g. C<"http://myapiserver/graphql">. + +This is required. + +=attr class + +The package name of a transport. + +By default this is automatically determined from the protocol portion of the L. + +=attr transport + +The transport object. + +By default this is automatically constructed based on the L. + +=attr unpack + +Whether or not to "unpack" the response, which enables a different style for error-handling. + +Default is 0. + +See L. + +=head1 ERROR HANDLING + +There are two different styles for handling errors. + +If L is 0 (off), every response -- whether success or failure -- is enveloped like this: + + { + data => {...}, + errors => [...], + } + +where C might be missing or undef if errors occurred (though not necessarily) and C +will be missing if the response completed without error. + +It is up to you to check for errors in the response, so your code might look like this: + + my $response = $client->request(...); + if (my $errors = $response->{errors}) { + # handle errors + } + my $data = $response->{data}; + # do something with $data + +If C is 1 (on), then L will return just the data if there were no errors, +otherwise it will throw an exception. So your code would look like this: + + my $data = eval { $client->request(...) }; + if (my $error = $@) { + # handle errors + } + # do something with $data + +Or if you want to handle errors in a different stack frame, your code is simply this: + + my $data = $client->request(...); + # do something with $data + +Both styles map to L responses intuitively. If C is 0, the response always resolves +to the envelope structure. If C is 1, successful responses will resolve to just the data and +errors will fail/reject. + diff --git a/lib/GraphQL/Client/http.pm b/lib/GraphQL/Client/http.pm new file mode 100644 index 0000000..5b9b634 --- /dev/null +++ b/lib/GraphQL/Client/http.pm @@ -0,0 +1,185 @@ +package GraphQL::Client::http; +# ABSTRACT: GraphQL over HTTP + +use warnings; +use strict; + +use HTTP::AnyUA::Util qw(www_form_urlencode); +use HTTP::AnyUA; + +our $VERSION = '999.999'; # VERSION + +sub new { + my $class = shift; + bless {@_}, $class; +} + +sub request { + my $self = shift; + my ($request, $options) = @_; + + my $url = $options->{url} || $self->url; + my $method = $options->{method} || $self->method; + + my $data = {%$request}; + + if ($method eq 'GET' || $method eq 'HEAD') { + $data->{variables} = $self->json->encode($data->{variables}) if $data->{variables}; + my $params = www_form_urlencode($data); + my $sep = $url =~ /\?/ ? '&' : '?'; + $url .= "${sep}${params}"; + } + else { + my $encoded_data = $self->json->encode($data); + $options->{content} = $encoded_data; + $options->{headers}{'content-length'} = length $encoded_data; + $options->{headers}{'content-type'} = 'application/json'; + } + + return $self->_handle_response($self->_any_ua->request($method, $url, $options)); +} + +sub _handle_response { + my $self = shift; + my ($resp) = @_; + + my $handle_error = sub { + my $resp = shift; + + return { + errors => [ + { + message => "HTTP transport returned $resp->{status}: $resp->{content}", + x_transport_response => $resp, + }, + ], + }; + }; + my $handle_response = sub { + my $resp = shift; + + return $handle_error->($resp) if !$resp->{success}; + return $self->json->decode($resp->{content}); + }; + + if ($self->_any_ua->response_is_future) { + return $resp->transform( + done => $handle_response, + fail => $handle_error, + ); + } + else { + return $handle_response->($resp); + } +} + +sub ua { + my $self = shift; + $self->{ua} //= do { + require HTTP::Tiny; + HTTP::Tiny->new( + agent => "perl-graphql-client/$VERSION", + ); + }; +} + +sub url { + my $self = shift; + $self->{url}; +} + +sub method { + my $self = shift; + $self->{method} // 'POST'; +} + +sub json { + my $self = shift; + $self->{json} //= do { + require JSON::MaybeXS; + JSON::MaybeXS->new(utf8 => 1); + }; +} + +sub _any_ua { + my $self = shift; + $self->{_any_ua} //= HTTP::AnyUA->new(ua => $self->ua); +} + +1; +__END__ + +=head1 SYNOPSIS + + my $transport = GraphQL::Client::http->new( + url => 'http://localhost:5000/graphql', + method => 'POST', + ); + + my $data = $client->request($query, $variables, $operation_name, $options); + +=head1 DESCRIPTION + +You probably shouldn't use this directly. Instead use L. + +C is a GraphQL transport for HTTP. GraphQL is not required to be transported +via HTTP, but this is definitely the most common way. + +This also serves as a reference implementation for future GraphQL transports. + +=method new + + $transport = GraphQL::Client::http->new(%attributes); + +Construct a new GraphQL HTTP transport. + +=method request + + $response = $client->request(\%data, \%options); + +Get a response from the GraphQL server. + +The C<%data> structure must have a C key whose value is the query or mutation string. It may +optionally have a C hashref an an C string. + +The C<%options> structure contains options passed through to the user agent. + +The response will either be a hashref with the following structure or a L that resolves to +such a hashref: + + { + data => {...}, + errors => [...], + } + +=attr ua + +A user agent, such as: + +=for :list +* instance of a L (this is the default if no user agent is provided) +* instance of a L +* the string C<"AnyEvent::HTTP"> +* and more... + +See L. + +=attr method + +The HTTP method to use when querying the GraphQL server. Can be one of: + +=for :list +* C +* C (default) + +=attr json + +The L (or compatible) object used for encoding and decoding data structures to and from +the GraphQL server. + +Defaults to a L. + +=head1 SEE ALSO + +L + diff --git a/lib/GraphQL/Client/https.pm b/lib/GraphQL/Client/https.pm new file mode 100644 index 0000000..56f2672 --- /dev/null +++ b/lib/GraphQL/Client/https.pm @@ -0,0 +1,21 @@ +package GraphQL::Client::https; +# ABSTRACT: GraphQL over HTTPS + +use warnings; +use strict; + +use parent 'GraphQL::Client::http'; + +our $VERSION = '999.999'; # VERSION + +sub new { + my $class = shift; + GraphQL::Client::http->new(@_); +} + +1; +__END__ + +=head1 SEE ALSO + +L -- 2.45.2