From d1fee928f02dbc30d3a38b746155ce5b12be4a1b Mon Sep 17 00:00:00 2001 From: Hakim Cassimally Date: Thu, 13 Mar 2014 16:56:02 +0000 Subject: Open311 Endpoint Subsystems include * ::Spark encoding conventions for xml/json * ::Schema using Rx to validate form of inputs and outputs, including validation for, e.g., dates and CSV as part of Open311 Handles following paths: * Open311 attributes for Service Definition http://wiki.open311.org/GeoReport_v2#GET_Service_Definition * POST service request * GET Service Requests * GET Service Request Objects: * ::Service * ::Service::Request --- cpanfile | 7 + cpanfile.snapshot | 213 ++++++- perllib/Open311/Endpoint.pm | 773 ++++++++++++++++++++++++++ perllib/Open311/Endpoint/Result.pm | 38 ++ perllib/Open311/Endpoint/Schema.pm | 174 ++++++ perllib/Open311/Endpoint/Schema/Comma.pm | 53 ++ perllib/Open311/Endpoint/Schema/Regex.pm | 43 ++ perllib/Open311/Endpoint/Service.pm | 53 ++ perllib/Open311/Endpoint/Service/Attribute.pm | 82 +++ perllib/Open311/Endpoint/Service/Request.pm | 107 ++++ perllib/Open311/Endpoint/Spark.pm | 116 ++++ t/open311/endpoint.t | 351 ++++++++++++ t/open311/endpoint/Endpoint1.pm | 114 ++++ t/open311/endpoint/ServiceType1.pm | 12 + t/open311/endpoint/schema.t | 82 +++ t/open311/endpoint/spark.t | 64 +++ 16 files changed, 2273 insertions(+), 9 deletions(-) create mode 100644 perllib/Open311/Endpoint.pm create mode 100644 perllib/Open311/Endpoint/Result.pm create mode 100644 perllib/Open311/Endpoint/Schema.pm create mode 100644 perllib/Open311/Endpoint/Schema/Comma.pm create mode 100644 perllib/Open311/Endpoint/Schema/Regex.pm create mode 100644 perllib/Open311/Endpoint/Service.pm create mode 100644 perllib/Open311/Endpoint/Service/Attribute.pm create mode 100644 perllib/Open311/Endpoint/Service/Request.pm create mode 100644 perllib/Open311/Endpoint/Spark.pm create mode 100644 t/open311/endpoint.t create mode 100644 t/open311/endpoint/Endpoint1.pm create mode 100644 t/open311/endpoint/ServiceType1.pm create mode 100644 t/open311/endpoint/schema.t create mode 100644 t/open311/endpoint/spark.t diff --git a/cpanfile b/cpanfile index 54fd8066e..8c48bc519 100644 --- a/cpanfile +++ b/cpanfile @@ -92,6 +92,13 @@ feature 'uk', 'FixMyStreet.com specific requirements' => sub { requires 'SOAP::WSDL'; }; +feature 'open311-endpoint', 'Open311::Endpoint specific requirements' => sub { + requires 'Web::Simple'; + requires 'Data::Rx'; + requires 'MooX::HandlesVia'; + requires 'Types::Standard'; +}; + #feature 'zurich', 'Zueri wie neu specific requirements' => sub { # # Geocoder # requires 'SOAP::Lite'; diff --git a/cpanfile.snapshot b/cpanfile.snapshot index 203583518..83b409e41 100644 --- a/cpanfile.snapshot +++ b/cpanfile.snapshot @@ -116,15 +116,6 @@ DISTRIBUTIONS provides: CPAN::Meta::Requirements 2.122 requirements: - Carp 0 - ExtUtils::MakeMaker 6.17 - File::Find 0 - File::Temp 0 - Scalar::Util 0 - Test::More 0.88 - strict 0 - version 0.77 - warnings 0 CPAN-Meta-YAML-0.008 pathname: D/DA/DAGOLDEN/CPAN-Meta-YAML-0.008.tar.gz provides: @@ -1308,6 +1299,75 @@ DISTRIBUTIONS Module::Build 0.35 Test::Exception 0 Test::More 0 + Data-Perl-0.002007 + pathname: M/MA/MATTP/Data-Perl-0.002007.tar.gz + provides: + Data::Perl 0.002007 + Data::Perl::Bool 0.002007 + Data::Perl::Code 0.002007 + Data::Perl::Collection::Array 0.002007 + Data::Perl::Collection::Hash 0.002007 + Data::Perl::Counter 0.002007 + Data::Perl::Number 0.002007 + Data::Perl::Role::Bool 0.002007 + Data::Perl::Role::Code 0.002007 + Data::Perl::Role::Collection::Array 0.002007 + Data::Perl::Role::Collection::Hash 0.002007 + Data::Perl::Role::Counter 0.002007 + Data::Perl::Role::Number 0.002007 + Data::Perl::Role::String 0.002007 + Data::Perl::String 0.002007 + requirements: + Class::Method::Modifiers 0 + ExtUtils::MakeMaker 6.30 + List::MoreUtils 0 + List::Util 0 + Module::Runtime 0 + Role::Tiny 0 + Scalar::Util 0 + parent 0 + strictures 0 + Data-Rx-0.200005 + pathname: R/RJ/RJBS/Data-Rx-0.200005.tar.gz + provides: + Data::Rx 0.200005 + Data::Rx::CommonType 0.200005 + Data::Rx::CommonType::EasyNew 0.200005 + Data::Rx::CoreType 0.200005 + Data::Rx::CoreType::all 0.200005 + Data::Rx::CoreType::any 0.200005 + Data::Rx::CoreType::arr 0.200005 + Data::Rx::CoreType::bool 0.200005 + Data::Rx::CoreType::def 0.200005 + Data::Rx::CoreType::fail 0.200005 + Data::Rx::CoreType::int 0.200005 + Data::Rx::CoreType::map 0.200005 + Data::Rx::CoreType::nil 0.200005 + Data::Rx::CoreType::num 0.200005 + Data::Rx::CoreType::one 0.200005 + Data::Rx::CoreType::rec 0.200005 + Data::Rx::CoreType::seq 0.200005 + Data::Rx::CoreType::str 0.200005 + Data::Rx::Failure 0.200005 + Data::Rx::FailureSet 0.200005 + Data::Rx::TypeBundle 0.200005 + Data::Rx::TypeBundle::Core 0.200005 + Data::Rx::Util 0.200005 + Test::RxTester undef + requirements: + Carp 0 + ExtUtils::MakeMaker 6.30 + File::Find::Rule 0 + JSON 2 + List::Util 0 + Number::Tolerant 0 + Scalar::Util 0 + Test::More 0.96 + autodie 0 + overload 0 + parent 0 + strict 0 + warnings 0 Data-Visitor-0.28 pathname: D/DO/DOY/Data-Visitor-0.28.tar.gz provides: @@ -2596,6 +2656,14 @@ DISTRIBUTIONS Test::More 0.88 Test::Requires 0 Try::Tiny 0 + Exporter-Tiny-0.036 + pathname: T/TO/TOBYINK/Exporter-Tiny-0.036.tar.gz + provides: + Exporter::Shiny 0.036 + Exporter::Tiny 0.036 + requirements: + ExtUtils::MakeMaker 6.17 + perl 5.006001 ExtUtils-CBuilder-0.280205 pathname: D/DA/DAGOLDEN/ExtUtils-CBuilder-0.280205.tar.gz provides: @@ -3656,6 +3724,22 @@ DISTRIBUTIONS Module::Runtime 0.012 Role::Tiny 1.003 strictures 1.004003 + MooX-HandlesVia-0.001005 + pathname: M/MA/MATTP/MooX-HandlesVia-0.001005.tar.gz + provides: + Data::Perl::Bool::MooseLike 0.001005 + Data::Perl::Collection::Array::MooseLike 0.001005 + Data::Perl::Collection::Hash::MooseLike 0.001005 + Data::Perl::Number::MooseLike 0.001005 + Data::Perl::String::MooseLike 0.001005 + MooX::HandlesVia 0.001005 + requirements: + Class::Method::Modifiers 0 + Data::Perl 0.002006 + ExtUtils::MakeMaker 6.30 + Module::Runtime 0 + Moo 1.003000 + Role::Tiny 0 Moose-2.0604 pathname: D/DO/DOY/Moose-2.0604.tar.gz provides: @@ -4290,6 +4374,27 @@ DISTRIBUTIONS requirements: ExtUtils::MakeMaker 0 Test::More 0 + Number-Tolerant-1.703 + pathname: R/RJ/RJBS/Number-Tolerant-1.703.tar.gz + provides: + Number::Tolerant 1.703 + Number::Tolerant::Constant 1.703 + Number::Tolerant::Type 1.703 + Number::Tolerant::Union 1.703 + Test::Tolerant 1.703 + requirements: + Carp 0 + ExtUtils::MakeMaker 6.30 + Math::BigFloat 0 + Math::BigRat 0 + Scalar::Util 0 + Sub::Exporter 0.950 + Sub::Exporter::Util 0 + Test::Builder 0 + overload 0 + parent 0 + strict 0 + warnings 0 Object-Signature-1.07 pathname: A/AD/ADAMK/Object-Signature-1.07.tar.gz provides: @@ -5211,6 +5316,14 @@ DISTRIBUTIONS constant 0 strict 0 warnings 0 + Syntax-Keyword-Gather-1.003000 + pathname: F/FR/FREW/Syntax-Keyword-Gather-1.003000.tar.gz + provides: + Syntax::Keyword::Gather 1.003000 + Syntax::Keyword::Gather::MagicArrayRef 1.003000 + requirements: + ExtUtils::MakeMaker 6.30 + Sub::Exporter::Progressive 0 Task-Weaken-1.04 pathname: A/AD/ADAMK/Task-Weaken-1.04.tar.gz provides: @@ -5814,6 +5927,48 @@ DISTRIBUTIONS constant 0 strict 0 warnings 0 + Type-Tiny-0.040 + pathname: T/TO/TOBYINK/Type-Tiny-0.040.tar.gz + provides: + Devel::TypeTiny::Perl56Compat 0.040 + Devel::TypeTiny::Perl58Compat 0.040 + Error::TypeTiny 0.040 + Error::TypeTiny::Assertion 0.040 + Error::TypeTiny::Compilation 0.040 + Error::TypeTiny::WrongNumberOfParameters 0.040 + Eval::TypeTiny 0.040 + Reply::Plugin::TypeTiny 0.040 + Test::TypeTiny 0.040 + Type::Coercion 0.040 + Type::Coercion::FromMoose 0.040 + Type::Coercion::Union 0.040 + Type::Library 0.040 + Type::Params 0.040 + Type::Parser 0.040 + Type::Registry 0.040 + Type::Tiny 0.040 + Type::Tiny::Class 0.040 + Type::Tiny::Duck 0.040 + Type::Tiny::Enum 0.040 + Type::Tiny::Intersection 0.040 + Type::Tiny::Role 0.040 + Type::Tiny::Union 0.040 + Type::Utils 0.040 + Types::Common::Numeric 0.040 + Types::Common::String 0.040 + Types::Standard 0.040 + Types::Standard::ArrayRef 0.040 + Types::Standard::Dict 0.040 + Types::Standard::HashRef 0.040 + Types::Standard::Map 0.040 + Types::Standard::ScalarRef 0.040 + Types::Standard::Tuple 0.040 + Types::TypeTiny 0.040 + requirements: + CPAN::Meta::Requirements 2.000 + Exporter::Tiny 0.026 + ExtUtils::MakeMaker 6.17 + perl 5.006001 UNIVERSAL-require-0.13 pathname: M/MS/MSCHWERN/UNIVERSAL-require-0.13.tar.gz provides: @@ -5980,6 +6135,38 @@ DISTRIBUTIONS XML::XPathEngine 0.08 YAML 0 perl 5.008001 + Web-Simple-0.020 + pathname: M/MS/MSTROUT/Web-Simple-0.020.tar.gz + provides: + CSS::Declare undef + CSS::Declare::Unex undef + HTML::Tags undef + Plack::Middleware::Dispatch undef + Web::Dispatch undef + Web::Dispatch::HTTPMethods undef + Web::Dispatch::HTTPMethods::Endpoint undef + Web::Dispatch::Node undef + Web::Dispatch::NotAnUpload undef + Web::Dispatch::ParamParser undef + Web::Dispatch::Parser undef + Web::Dispatch::Predicates undef + Web::Dispatch::ToApp undef + Web::Dispatch::Upload undef + Web::Dispatch::Wrapper undef + Web::Simple 0.020 + Web::Simple::Application undef + Web::Simple::DispatchNode undef + XML::Tags undef + XML::Tags::StringThing undef + XML::Tags::TIEHANDLE undef + XML::Tags::Unex undef + requirements: + Data::Dumper::Concise 2.020 + ExtUtils::MakeMaker 0 + Moo 0.009014 + Plack 0.9968 + Syntax::Keyword::Gather 1.001 + warnings::illegalproto 0.001 XML-NamespaceSupport-1.11 pathname: P/PE/PERIGRIN/XML-NamespaceSupport-1.11.tar.gz provides: @@ -6294,3 +6481,11 @@ DISTRIBUTIONS ExtUtils::MakeMaker 0 File::Temp 0.13 Test::More 0.45 + warnings-illegalproto-0.001001 + pathname: F/FR/FREW/warnings-illegalproto-0.001001.tar.gz + provides: + warnings::illegalproto 0.001001 + requirements: + ExtUtils::MakeMaker 6.30 + Test::More 0.92 + strictures 1 diff --git a/perllib/Open311/Endpoint.pm b/perllib/Open311/Endpoint.pm new file mode 100644 index 000000000..8a440e4ae --- /dev/null +++ b/perllib/Open311/Endpoint.pm @@ -0,0 +1,773 @@ +package Open311::Endpoint; + +=head1 NAME + +Open311::Endpoint - a generic Open311 endpoint implementation + +=cut + +use Web::Simple; + +use JSON; +use XML::Simple; + +use Open311::Endpoint::Result; +use Open311::Endpoint::Service; +use Open311::Endpoint::Service::Request; +use Open311::Endpoint::Spark; +use Open311::Endpoint::Schema; + +use MooX::HandlesVia; + +use Data::Dumper; +use Scalar::Util 'blessed'; +use List::Util 'first'; +use Types::Standard ':all'; + +use DateTime::Format::W3CDTF; + +=head1 DESCRIPTION + +An implementation of L with a +dispatcher written as a L application, designed to be easily +deployed. + +This is a generic wrapper, designed to be a conformant Open311 server. +However, it knows nothing about your business logic! You should subclass it +and provide the necessary methods. + +=head1 SUBCLASSING + +See also t/open311/endpoint/Endpoint1.pm as an example. + +=head2 methods to override + +These are the important methods to override. They are passed a list of +simple arguments, and should generally return objects like +L. + + services + service + post_service_request + get_service_requests + get_service_request + requires_jurisdiction_ids + check_jurisdiction_id + +The dispatch framework will take care of actually formatting the output +into conformant XML or JSON. + +TODO document better + +=cut + +sub services { + # this should be overridden in your subclass! + (); +} +sub service { + # this stub implementation is a simple lookup on $self->services, and + # should *probably* be overridden in your subclass! + # (for example, to look up in App DB, with $args->{jurisdiction_id}) + + my ($self, $service_code, $args) = @_; + + return first { $_->service_code eq $service_code } $self->services; +} + +sub post_service_request { + my ($self, $service, $args) = @_; + + die "abstract method post_service_request not overridden"; +} + +sub get_service_requests { + my ($self, $args) = @_; + die "abstract method get_service_requests not overridden"; +} + +sub get_service_request { + my ($self, $service_request_id, $args) = @_; + + die "abstract method get_service_request not overridden"; +} + +sub requires_jurisdiction_ids { + # you may wish to subclass this + return shift->has_multiple_jurisdiction_ids; +} + +sub check_jurisdiction_id { + my ($self, $jurisdiction_id) = @_; + + # you may wish to override this stub implementation which: + # - always succeeds if no jurisdiction_id is set + # - accepts no jurisdiction_id if there is only one set + # - otherwise checks that the id passed is one of those set + # + return 1 unless $self->has_jurisdiction_ids; + + if (! defined $jurisdiction_id) { + return $self->requires_jurisdiction_ids ? 1 : undef; + } + + return first { $jurisdiction_id eq $_ } $self->get_jurisdiction_ids; +} + + + +=head2 Configurable arguments + + * default_service_notice - default for if not + set by the service or an individual request + * jurisdictions - an array of jurisdiction_ids + you may want to subclass the methods: + - requires_jurisdiction_ids + - check_jurisdiction_id + * default_identifier_type + Open311 doesn't mandate what these types look like, but a backend + server may! The module provides an example identifier type which allows + ascii "word" characters .e.g [a-zA-Z0-9_] as an example default. + You can also override these individually using: + + identifier_types => { + api_key => '//str', # + jurisdiction_id => ... + service_code => ... + service_request_id => ... + # etc. + } + +=cut + +has default_identifier_type => ( + is => 'ro', + isa => Str, + default => '/open311/example/identifier', +); + +has identifier_types => ( + is => 'ro', + isa => HashRef[Str], + default => sub { {} }, + handles_via => 'Hash', + handles => { + get_identifier_type => 'get', + }, +); + +around get_identifier_type => sub { + my ($orig, $self, $type) = @_; + return $self->$orig($type) // $self->default_identifier_type; +}; + +has default_service_notice => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has jurisdiction_ids => ( + is => 'ro', + isa => Maybe[ArrayRef], + default => sub { [] }, + handles_via => 'Array', + handles => { + has_jurisdiction_ids => 'count', + get_jurisdiction_ids => 'elements', + } +); + +=head2 Other accessors + +You may additionally wish to replace the following objects. + + * schema - Data::Rx schema for validating Open311 protocol inputs and + outputs + * spark - methods for munging base data-structure for output + * json - JSON output object + * xml - XML::Simple output object + +=cut + +has schema => ( + is => 'lazy', + default => sub { + my $self = shift; + Open311::Endpoint::Schema->new( endpoint => $self ), + }, + handles => { + rx => 'schema', + format_boolean => 'format_boolean', + }, +); + +has spark => ( + is => 'lazy', + default => sub { + Open311::Endpoint::Spark->new(); + }, +); + +has json => ( + is => 'lazy', + default => sub { + JSON->new->pretty->allow_blessed->convert_blessed; + }, +); + +has xml => ( + is => 'lazy', + default => sub { + XML::Simple->new( + NoAttr=> 1, + KeepRoot => 1, + SuppressEmpty => 0, + ); + }, +); + +has w3_dt => ( + is => 'lazy', + default => sub { DateTime::Format::W3CDTF->new }, +); + +=head2 Dispatching + +The method dispatch_request returns a list of all the dispatcher routines +that will be checked in turn by L. + +You may extend this in a subclass, or with a role. + +=cut + +sub dispatch_request { + my $self = shift; + + sub (.*) { + my ($self, $ext) = @_; + $self->format_response($ext); + }, + + sub (GET + /services + ?*) { + my ($self, $args) = @_; + $self->call_api( GET_Service_List => $args ); + }, + + sub (GET + /services/* + ?*) { + my ($self, $service_id, $args) = @_; + $self->call_api( GET_Service_Definition => $service_id, $args ); + }, + + sub (POST + /requests + %*) { + my ($self, $args) = @_; + $self->call_api( POST_Service_Request => $args ); + }, + + sub (GET + /tokens/*) { + return Open311::Endpoint::Result->error( 400, 'not implemented' ); + }, + + sub (GET + /requests + ?*) { + my ($self, $args) = @_; + $self->call_api( GET_Service_Requests => $args ); + }, + + sub (GET + /requests/* + ?*) { + my ($self, $service_request_id, $args) = @_; + $self->call_api( GET_Service_Request => $service_request_id, $args ); + }, +} + +sub GET_Service_List_input_schema { + return shift->get_jurisdiction_id_validation; +} + +sub GET_Service_List_output_schema { + return { + type => '//rec', + required => { + services => { + type => '//arr', + contents => '/open311/service', + }, + } + }; +} + +sub GET_Service_List { + my ($self, @args) = @_; + + my @services = map { + my $service = $_; + { + keywords => (join ',' => @{ $service->keywords } ), + metadata => $self->format_boolean( $service->has_attributes ), + map { $_ => $service->$_ } + qw/ service_name service_code description type group /, + } + } $self->services; + return { + services => \@services, + }; +} + +sub GET_Service_Definition_input_schema { + my $self = shift; + return { + type => '//seq', + contents => [ + $self->get_identifier_type('service_code'), + $self->get_jurisdiction_id_validation, + ], + }; +} + +sub GET_Service_Definition_output_schema { + return { + type => '//rec', + required => { + service_definition => { + type => '/open311/service_definition', + }, + } + }; +} + +sub GET_Service_Definition { + my ($self, $service_id, $args) = @_; + + my $service = $self->service($service_id, $args) or return; + my $order = 0; + my $service_definition = { + service_definition => { + service_code => $service_id, + attributes => [ + map { + my $attribute = $_; + { + order => ++$order, + variable => $self->format_boolean( $attribute->variable ), + required => $self->format_boolean( $attribute->required ), + $attribute->has_values ? ( + values => [ + map { + my ($key, $name) = @$_; + +{ + key => $key, + name => $name, + } + } $attribute->values_kv + ]) : (), + map { $_ => $attribute->$_ } + qw/ code datatype datatype_description description /, + } + } $service->get_attributes, + ], + }, + }; + return $service_definition; +} + +sub POST_Service_Request_input_schema { + my ($self, $args) = @_; + + my $service_code = $args->{service_code}; + unless ($service_code && $args->{api_key}) { + # return a simple validator + # to give a nice error message + return { + type => '//rec', + required => { + service_code => $self->get_identifier_type('service_code'), + api_key => $self->get_identifier_type('api_key') }, + rest => '//any', + }; + } + + my $service = $self->service($service_code) + or return; # we can't fetch service, so signal error TODO + + my %attributes; + for my $attribute ($service->get_attributes) { + my $section = $attribute->required ? 'required' : 'optional'; + my $key = sprintf 'attribute[%s]', $attribute->code; + my $def = $attribute->schema_definition; + + $attributes{ $section }{ $key } = $def; + } + + # we have to supply at least one of these, but can supply more + my @address_options = ( + { lat => '//num', long => '//num' }, + { address_string => '//str' }, + { address_id => '//str' }, + ); + + my @address_schemas; + while (my $address_required = shift @address_options) { + push @address_schemas, + { + type => '//rec', + required => { + service_code => $self->get_identifier_type('service_code'), + api_key => $self->get_identifier_type('api_key'), + %{ $attributes{required} }, + %{ $address_required }, + $self->get_jurisdiction_id_required_clause, + }, + optional => { + email => '//str', + device_id => '//str', + account_id => '//str', + first_name => '//str', + last_name => '//str', + phone => '//str', + description => '//str', + media_url => '//str', + %{ $attributes{optional} }, + (map %$_, @address_options), + $self->get_jurisdiction_id_optional_clause, + }, + }; + } + + return { + type => '//any', + of => \@address_schemas, + }; +} + +sub POST_Service_Request_output_schema { + my ($self, $args) = @_; + + my $service_code = $args->{service_code}; + my $service = $self->service($service_code); + + my %return_schema = ( + ($service->type eq 'realtime') ? ( service_request_id => $self->get_identifier_type('service_request_id') ) : (), + ($service->type eq 'batch') ? ( token => '//str' ) : (), + ); + + return { + type => '//rec', + required => { + service_requests => { + type => '//arr', + contents => { + type => '//rec', + required => { + %return_schema, + }, + optional => { + service_notice => '//str', + account_id => '//str', + + }, + }, + }, + }, + }; +} + +sub POST_Service_Request { + my ($self, $args) = @_; + + # TODO pass this through instead of calculating again? + my $service_code = $args->{service_code}; + my $service = $self->service($service_code); + + my @service_requests = $self->post_service_request( $service, $args ); + + return { + service_requests => [ + map { + my $service_notice = + $_->service_notice + || $service->default_service_notice + || $self->default_service_notice; + +{ + ($service->type eq 'realtime') ? ( service_request_id => $_->service_request_id ) : (), + ($service->type eq 'batch') ? ( token => $_->token ) : (), + $service_notice ? ( service_notice => $service_notice ) : (), + $_->has_account_id ? ( account_id => $_->account_id ) : (), + } + } @service_requests, + ], + }; +} + +sub GET_Service_Requests_input_schema { + my $self = shift; + return { + type => '//rec', + required => { + $self->get_jurisdiction_id_required_clause, + }, + optional => { + $self->get_jurisdiction_id_optional_clause,, + service_request_id => { + type => '/open311/comma', + contents => $self->get_identifier_type('service_request_id'), + }, + service_code => { + type => '/open311/comma', + contents => $self->get_identifier_type('service_code'), + }, + start_date => '/open311/datetime', + end_date => '/open311/datetime', + status => { + type => '/open311/comma', + contents => '/open311/status', + }, + }, + }; +} + +sub GET_Service_Requests_output_schema { + my $self = shift; + return { + type => '//rec', + required => { + service_requests => { + type => '//arr', + contents => '/open311/service_request', + }, + }, + }; +} + +sub GET_Service_Requests { + my ($self, $args) = @_; + + my @service_requests = $self->get_service_requests({ + + jurisdiction_id => $args->{jurisdiction_id}, + start_date => $args->{start_date}, + end_date => $args->{end_date}, + + map { + $args->{$_} ? + ( $_ => [ split ',' => $args->{$_} ] ) + : () + } qw/ service_request_id service_code status /, + }); + + $self->format_service_requests(@service_requests); +} + +sub GET_Service_Request_input_schema { + my $self = shift; + return { + type => '//seq', + contents => [ + $self->get_identifier_type('service_request_id'), + { + type => '//rec', + required => { + $self->get_jurisdiction_id_required_clause, + }, + optional => { + $self->get_jurisdiction_id_optional_clause, + } + } + ], + }; +} + +sub GET_Service_Request_output_schema { + my $self = shift; + return { + type => '//rec', + required => { + service_requests => { + type => '//seq', # e.g. a single service_request + contents => [ + '/open311/service_request', + ] + }, + }, + }; +} + +sub GET_Service_Request { + my ($self, $service_request_id, $args) = @_; + + my $service_request = $self->get_service_request($service_request_id, $args); + + $self->format_service_requests($service_request); +} + +sub format_service_requests { + my ($self, @service_requests) = @_; + return { + service_requests => [ + map { + my $request = $_; + +{ + ( + map { + $_ => $request->$_, + } + qw/ + service_request_id + status + service_name + service_code + address + address_id + zipcode + lat + long + media_url + / + ), + ( + map { + $_ => $self->w3_dt->format_datetime( $request->$_ ), + } + qw/ + requested_datetime + updated_datetime + / + ), + ( + map { + my $value = $request->$_; + $value ? ( $_ => $value ) : (), + } + qw/ + description + agency_responsible + service_notice + / + ), + } + } @service_requests, + ], + }; +} + +sub has_multiple_jurisdiction_ids { + return shift->has_jurisdiction_ids > 1; +} + +sub get_jurisdiction_id_validation { + my $self = shift; + + # jurisdiction_id is documented as "Required", but with the note + # 'This is only required if the endpoint serves multiple jurisdictions' + # i.e. it is optional as regards the schema, but the server may choose + # to error if it is not provided. + return { + type => '//rec', + ($self->requires_jurisdiction_ids ? 'required' : 'optional') => { + jurisdiction_id => $self->get_identifier_type('jurisdiction_id'), + }, + }; +} + +sub get_jurisdiction_id_required_clause { + my $self = shift; + $self->requires_jurisdiction_ids ? (jurisdiction_id => $self->get_identifier_type('jurisdiction_id')) : (); +} + +sub get_jurisdiction_id_optional_clause { + my $self = shift; + $self->requires_jurisdiction_ids ? () : (jurisdiction_id => $self->get_identifier_type('jurisdiction_id')); +} + +sub call_api { + my ($self, $api_name, @args) = @_; + + my $api_method = $self->can($api_name) + or die "No such API $api_name!"; + + if (my $input_schema_method = $self->can("${api_name}_input_schema")) { + my $input_schema = $self->$input_schema_method(@args) + or return Open311::Endpoint::Result->error( 400, + 'Bad request' ); + + my $schema = $self->rx->make_schema( $input_schema ); + my $input = (scalar @args == 1) ? $args[0] : [@args]; + eval { + $schema->assert_valid( $input ); + }; + if ($@) { + return Open311::Endpoint::Result->error( 400, + "Error in input for $api_name", + split /\n/, $@, + # map $_->struct, @{ $@->failures }, # bit cheeky, spec suggests it wants strings only + ); + } + } + + my $data = eval { $self->$api_method(@args) } + or return Open311::Endpoint::Result->error( + $@ ? (500 => $@) : (404 => 'Resource not found') + ); + + if (my $output_schema_method = $self->can("${api_name}_output_schema")) { + my $definition = $self->$output_schema_method(@args); + my $schema = $self->rx->make_schema( $definition ); + eval { + $schema->assert_valid( $data ); + }; + if ($@) { + return Open311::Endpoint::Result->error( 500, + "Error in output for $api_name", + split /\n/, $@, + # map $_->struct, @{ $@->failures }, + ); + } + } + + return Open311::Endpoint::Result->success( $data ); +} + +sub format_response { + my ($self, $ext) = @_; + response_filter { + my $response = shift; + return $response unless blessed $response; + my $status = $response->status; + my $data = $response->data; + if ($ext eq 'json') { + return [ + $status, + [ 'Content-Type' => 'application/json' ], + [ $self->json->encode( + $self->spark->process_for_json( $data ) + )] + ]; + } + elsif ($ext eq 'xml') { + return [ + $status, + [ 'Content-Type' => 'text/xml' ], + [ qq(\n), + $self->xml->XMLout( + $self->spark->process_for_xml( $data ) + )], + ]; + } + else { + return [ + 404, + [ 'Content-Type' => 'text/plain' ], + [ 'Bad extension. We support .xml and .json' ], + ] + } + } +} + +=head1 AUTHOR and LICENSE + + hakim@mysociety.org 2014 + +This is released under the same license as FixMyStreet. +see https://github.com/mysociety/fixmystreet/blob/master/LICENSE.txt + +=cut + +__PACKAGE__->run_if_script; diff --git a/perllib/Open311/Endpoint/Result.pm b/perllib/Open311/Endpoint/Result.pm new file mode 100644 index 000000000..2d3c42154 --- /dev/null +++ b/perllib/Open311/Endpoint/Result.pm @@ -0,0 +1,38 @@ +package Open311::Endpoint::Result; +use Moo; + +has status => ( + is => 'ro', +); +has data => ( + is => 'ro', +); + +sub success { + my ($class, $data) = @_; + return $class->new({ + status => 200, + data => $data, + }); +} + +sub error { + my ($class, $code, @errors) = @_; + $code ||= 400; + return $class->new({ + status => $code, + data => { + errors => [ + map { + ref $_ eq 'HASH' ? $_ : + { + code => $code, + description => $_, + } + } @errors, + ], + }, + }); +} + +1; diff --git a/perllib/Open311/Endpoint/Schema.pm b/perllib/Open311/Endpoint/Schema.pm new file mode 100644 index 000000000..e30f9ad90 --- /dev/null +++ b/perllib/Open311/Endpoint/Schema.pm @@ -0,0 +1,174 @@ +package Open311::Endpoint::Schema; +use Moo; +use Data::Rx; + +use Open311::Endpoint::Schema::Comma; +use Open311::Endpoint::Schema::Regex; + +use Carp 'confess'; +has endpoint => ( + is => 'ro', + handles => [qw/ + get_jurisdiction_id_required_clause + get_jurisdiction_id_optional_clause + get_identifier_type + /], +); + +sub enum { + my ($self, $type, @values) = @_; + return { + type => '//any', + of => [ map { + { + type => $type, + value => $_, + } + } @values ], + }; +} + +sub format_boolean { + my ($self, $value) = @_; + return $value ? 'true' : 'false'; +} + +has schema => ( + is => 'lazy', + default => sub { + my $self = shift; + + my $schema = Data::Rx->new({ + sort_keys => 1, + prefix => { + open311 => 'tag:wiki.open311.org,GeoReport_v2:rx/', + }, + type_plugins => [qw( + Open311::Endpoint::Schema::Comma + Open311::Endpoint::Schema::Regex + )], + }); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/bool', + $self->enum( '//str', qw[ true false ] )); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/datetime', + { + type => '/open311/regex', + pattern => qr{ + ^ + \d{4} - \d{2} - \d{2} # yyyy-mm-dd + T + \d{2} : \d{2} : \d{2} # hh:mm:ss + (?: + Z # "Zulu" time, e.g. UTC + | [+-] \d{2} : \d{2} # +/- hh:mm offset + ) + $ + }ax, # use ascii semantics so /d means [0-9], and allow formatting + message => "found value isn't a datetime", + }); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/example/identifier', + { + type => '/open311/regex', + pattern => qr{^ \w+ $}ax, + message => "found value isn't a valid identifier", + }); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/status', + $self->enum( '//str', qw[ open closed ] )); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/post_type', + $self->enum( '//str', qw[ realtime batch blackbox ] )); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service', + { + type => '//rec', + required => { + service_name => '//str', + type => '/open311/post_type', + metadata => '/open311/bool', + description => '//str', + service_code => '//str', + }, + optional => { + keywords => '//str', + group => '//str', + } + } + ); + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/value', + { + type => '//rec', + required => { + key => '//str', + name => '//str', + } + } + ); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/attribute', + { + type => '//rec', + required => { + code => '//str', + datatype => $self->enum( '//str', qw[ string number datetime text singlevaluelist multivaluelist ] ), + datatype_description => '//str', + description => '//str', + order => '//int', + required => '/open311/bool', + variable => '/open311/bool', + }, + optional => { + values => { + type => '//arr', + contents => '/open311/value', + }, + }, + } + ); + + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service_definition', + { + type => '//rec', + required => { + service_code => '//str', + attributes => { + type => '//arr', + contents => '/open311/attribute', + } + }, + } + ); + $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service_request', + { + type => '//rec', + required => { + service_request_id => $self->get_identifier_type('service_request_id'), + status => '/open311/status', + service_name => '//str', + service_code => $self->get_identifier_type('service_code'), + requested_datetime => '/open311/datetime', + updated_datetime => '/open311/datetime', + address => '//str', + address_id => '//str', + zipcode => '//str', + lat => '//num', + long => '//num', + media_url => '//str', + }, + optional => { + request => '//str', + description => '//str', + agency_responsible => '//str', + service_notice => '//str', + }, + } + ); + + return $schema; + }, +); + +1; diff --git a/perllib/Open311/Endpoint/Schema/Comma.pm b/perllib/Open311/Endpoint/Schema/Comma.pm new file mode 100644 index 000000000..f6ac1bcc7 --- /dev/null +++ b/perllib/Open311/Endpoint/Schema/Comma.pm @@ -0,0 +1,53 @@ +use strict; use warnings; +package Open311::Endpoint::Schema::Comma; +use parent 'Data::Rx::CommonType::EasyNew'; + +use Carp (); + +sub type_uri { + 'tag:wiki.open311.org,GeoReport_v2:rx/comma', +} + +sub guts_from_arg { + my ($class, $arg, $rx) = @_; + $arg ||= {}; + + my $contents = delete $arg->{contents} + or Carp::croak "No contents for comma-separated list"; + my $trim = delete $arg->{trim}; + if (my @unexpected = keys %$arg) { + Carp::croak sprintf "Unknown arguments %s in constructing %s", + (join ',' => @unexpected), $class->type_uri; + } + + return { + trim => $trim, + str_schema => $rx->make_schema('//str'), + subschema => $rx->make_schema( $contents ), + }; +} + +sub assert_valid { + my ($self, $value) = @_; + + $self->{str_schema}->assert_valid( $value ); + + my @values = split ',' => $value; + + my $subschema = $self->{subschema}; + my $trim = $self->{trim}; + + for my $subvalue (@values) { + + if ($self->{trim}) { + $subvalue =~s/^\s*//; + $subvalue =~s/\s*$//; + } + + $subschema->assert_valid( $subvalue ); + } + + return 1; +} + +1; diff --git a/perllib/Open311/Endpoint/Schema/Regex.pm b/perllib/Open311/Endpoint/Schema/Regex.pm new file mode 100644 index 000000000..a79542198 --- /dev/null +++ b/perllib/Open311/Endpoint/Schema/Regex.pm @@ -0,0 +1,43 @@ +use strict; use warnings; +package Open311::Endpoint::Schema::Regex; +use parent 'Data::Rx::CommonType::EasyNew'; + +use Carp (); + +sub type_uri { + 'tag:wiki.open311.org,GeoReport_v2:rx/regex', +} + +sub guts_from_arg { + my ($class, $arg, $rx) = @_; + $arg ||= {}; + + my $pattern = delete $arg->{pattern}; + my $message = delete $arg->{message}; + if (my @unexpected = keys %$arg) { + Carp::croak sprintf "Unknown arguments %s in constructing %s", + (join ',' => @unexpected), $class->type_uri; + } + + return { + str_schema => $rx->make_schema('//str'), + pattern => qr/$pattern/, + message => $message, + }; +} + +sub assert_valid { + my ($self, $value) = @_; + + $self->{str_schema}->assert_valid( $value ); + + return 1 if $value =~ $self->{pattern}; + + $self->fail({ + error => [ qw(type) ], + message => $self->{message} || "found value doesn't match regex", + value => $value, + }) +} + +1; diff --git a/perllib/Open311/Endpoint/Service.pm b/perllib/Open311/Endpoint/Service.pm new file mode 100644 index 000000000..282e5f921 --- /dev/null +++ b/perllib/Open311/Endpoint/Service.pm @@ -0,0 +1,53 @@ +package Open311::Endpoint::Service; +use Moo; +use MooX::HandlesVia; +use Types::Standard ':all'; +use namespace::clean; + +has service_name => ( + is => 'ro', + isa => Str, +); + +has service_code => ( + is => 'ro', + isa => Str, +); + +has default_service_notice => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has description => ( + is => 'ro', + isa => Str, +); + +has keywords => ( + is => 'ro', + isa => ArrayRef[Str], +); + +has group => ( + is => 'ro', + isa => Str, +); + +has type => ( + is => 'ro', + isa => Enum[qw/ realtime batch blackbox /], +); + +has attributes => ( + is => 'ro', + isa => ArrayRef[ InstanceOf['Open311::Endpoint::Service::Attribute'] ], + handles_via => 'Array', + handles => { + has_attributes => 'count', + get_attributes => 'elements', + } +); + +1; diff --git a/perllib/Open311/Endpoint/Service/Attribute.pm b/perllib/Open311/Endpoint/Service/Attribute.pm new file mode 100644 index 000000000..f88919408 --- /dev/null +++ b/perllib/Open311/Endpoint/Service/Attribute.pm @@ -0,0 +1,82 @@ +package Open311::Endpoint::Service::Attribute; +use Moo; +use MooX::HandlesVia; +use Types::Standard ':all'; +use namespace::clean; + +# from http://wiki.open311.org/GeoReport_v2#GET_Service_Definition + +# A unique identifier for the attribute +has code => ( + is => 'ro', + isa => Str, +); + +# true denotes that user input is needed +# false means the attribute is only used to present information to the user within the description field +# +# NB: unsure what false means for the rest of the options here, e.g. should remainder of fields by Maybe[] ? +has variable => ( + is => 'ro', + isa => Bool, + default => sub { 1 }, +); + +# Denotes the type of field used for user input. +has datatype => ( + is => 'ro', + isa => Enum[qw/ string number datetime text singlevaluelist multivaluelist /], +); + +has required => ( + is => 'ro', + isa => Bool, +); + +# A description of the datatype which helps the user provide their input +has datatype_description => ( + is => 'ro', + isa => Str, +); + +# A description of the attribute field with instructions for the user to find +# and identify the requested information +has description => ( + is => 'ro', + isa => Str, +); + +# NB: we don't model the "Order" field here, as that's really for the Service +# object to return + +# only relevant for singlevaluelist or multivaluelist +has values => ( + is => 'ro', + isa => HashRef, + default => sub { {} }, + handles_via => 'Hash', + handles => { + get_value => 'get', + get_values => 'keys', + has_values => 'count', + values_kv => 'kv', + } +); + +sub schema_definition { + my $self = shift; + + my @values = map +{ type => '//str', value => $_ }, $self->get_values; + my %schema_types = ( + string => '//str', + number => '//num', + datetime => '//str', # TODO + text => '//str', + singlevaluelist => { type => '//any', of => [@values] }, + multivaluelist => { type => '//arr', of => [@values] }, + ); + + return $schema_types{ $self->datatype }; +} + +1; diff --git a/perllib/Open311/Endpoint/Service/Request.pm b/perllib/Open311/Endpoint/Service/Request.pm new file mode 100644 index 000000000..b56cee393 --- /dev/null +++ b/perllib/Open311/Endpoint/Service/Request.pm @@ -0,0 +1,107 @@ +package Open311::Endpoint::Service::Request; +use Moo; +use Types::Standard ':all'; +use namespace::clean; + +has service => ( + is => 'ro', + isa => InstanceOf['Open311::Endpoint::Service'], + handles => [ + qw/ service_code service_name / + ], +); + +has service_request_id => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has token => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has service_notice => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has account_id => ( + is => 'ro', + isa => Maybe[Str], + predicate => 1, +); + +has status => ( + is => 'rw', + isa => Enum[qw/ open closed /], + default => sub { 'open' }, +); + +has description => ( + is => 'ro', + isa => Maybe[Str], +); + +has agency_responsible => ( + is => 'ro', + isa => Maybe[Str], +); + +has requested_datetime => ( + is => 'ro', + isa => Maybe[ InstanceOf['DateTime'] ], +); + +has updated_datetime => ( + is => 'ro', + isa => Maybe[ InstanceOf['DateTime'] ], +); + +has expected_datetime => ( + is => 'ro', + isa => Maybe[ InstanceOf['DateTime'] ], +); + +has address => ( + is => 'ro', + isa => Str, + default => sub { '' }, +); + +has address_id => ( + is => 'ro', + isa => Str, + default => sub { '' }, +); + +has zipcode => ( + is => 'ro', + isa => Str, + default => sub { '' }, +); + +has latlong => ( + is => 'ro', + isa => Tuple[ Num, Num ], + default => sub { [0,0] }, + handles_via => 'Array', + handles => { + #lat => [ get => 0 ], + #long => [ get => 1 ], + } +); + +sub lat { shift->latlong->[0] } +sub long { shift->latlong->[1] } + +has media_url => ( + is => 'ro', + isa => Str, + default => sub { '' }, +); + +1; diff --git a/perllib/Open311/Endpoint/Spark.pm b/perllib/Open311/Endpoint/Spark.pm new file mode 100644 index 000000000..ae179cecc --- /dev/null +++ b/perllib/Open311/Endpoint/Spark.pm @@ -0,0 +1,116 @@ +package Open311::Endpoint::Spark; +use Moo; +use Data::Visitor::Callback; + +=head1 NAME + +Open311::Endpoint::Spark - transform from canonical data-structure to XML or JSON + +=head1 SUMMARY + +The Open311 docs discuss the Spark convention, to transform between XML and JSON. + + http://wiki.open311.org/JSON_and_XML_Conversion#The_Spark_Convention + +These options seem fragile, and require starting with the verbose XML form, +which isn't really natural in Perl. Instead, we'll start with a standard +Perl data structure, with a single extra hash wrapper, and will: + + * for JSON, remove the outside hash wrapper + + * for XML, for arrays, insert an extra layer with the singular name: + (this is the way XML::Simple knows how to do this nesting) + +So: + + # FROM + { + foo => { + bars => [ 1, 2, 3 ] + } + } + + # JSON (note the 'foo' has been removed + { + bars: [ + 1, + 2, + 3 + ] + } + + # XML intermediate + { + foo => { + bars => { + bar => [ 1, 2, 3 ] + } + } + } + + # XML result + + + 1 + 2 + 3 + + + +=cut + +sub process_for_json { + my ($self, $data) = @_; + if (ref $data eq 'HASH' and scalar keys %$data == 1) { + my $inner = $data->{ (keys %$data)[0] }; + $data = $inner if ref $inner; + } + return $data; +} + +sub process_for_xml { + my ($self, $data) = @_; + + # NB: in place mutation + _process_for_xml($data); + return $data; +} + +# NB: in place mutation +sub _process_for_xml { + my $data = shift; + return unless ref $data; + + if (ref $data eq 'HASH') { + while ( my ($k, $v) = each %$data) { + if (ref $v eq 'ARRAY') { + my $singular = _singularize($k); + # add extra layer + $data->{$k} = { + $singular => $v, + }; + } + _process_for_xml($v); + } + } + elsif (ref $data eq 'ARRAY') { + for my $item (@$data) { + _process_for_xml($item); + } + } +} + +my %singular_map = ( + service_requests => 'request', +); +sub _singularize { + my $name = shift; + return $singular_map{ $name } + || do { + # strip final 's' if present + $name =~ s/s$//; + return $name; + }; +} + +1; diff --git a/t/open311/endpoint.t b/t/open311/endpoint.t new file mode 100644 index 000000000..fd794feec --- /dev/null +++ b/t/open311/endpoint.t @@ -0,0 +1,351 @@ +use strict; use warnings; + +use Test::More; +use Test::LongString; +use Test::MockTime ':all'; + +use Open311::Endpoint; +use Data::Dumper; +use JSON; + +use t::open311::endpoint::Endpoint1; + +my $endpoint = t::open311::endpoint::Endpoint1->new; +my $json = JSON->new; + +subtest "GET Service List" => sub { + my $res = $endpoint->run_test_request( GET => '/services.xml' ); + ok $res->is_success, 'xml success' + or diag $res->content; + is_string $res->content, < + + + Pothole Repairs Service + highways + deep,hole,wow + true + POT + Pothole Repairs + realtime + + + Bin Enforcement Service + sanitation + bin + false + BIN + Bin Enforcement + realtime + + +CONTENT + + $res = $endpoint->run_test_request( GET => '/services.json' ); + ok $res->is_success, 'json success'; + is_deeply $json->decode($res->content), + [ { + "keywords" => "deep,hole,wow", + "group" => "highways", + "service_name" => "Pothole Repairs", + "type" => "realtime", + "metadata" => "true", + "description" => "Pothole Repairs Service", + "service_code" => "POT" + }, { + "keywords" => "bin", + "group" => "sanitation", + "service_name" => "Bin Enforcement", + "type" => "realtime", + "metadata" => "false", + "description" => "Bin Enforcement Service", + "service_code" => "BIN" + } ], 'json structure ok'; + +}; + +subtest "GET Service Definition" => sub { + my $res = $endpoint->run_test_request( GET => '/services/POT.xml' ); + ok $res->is_success, 'xml success', + or diag $res->content; + is_string $res->content, < + + + + depth + number + an integer + depth of pothole, in centimetres + 1 + true + true + + + shape + singlevaluelist + square | circle | triangle + shape of the pothole + 2 + false + + + Triangle + triangle + + + Circle + circle + + + Square + square + + + true + + + POT + +CONTENT + + $res = $endpoint->run_test_request( GET => '/services/POT.json' ); + ok $res->is_success, 'json success'; + is_deeply $json->decode($res->content), + { + "service_code" => "POT", + "attributes" => [ + { + "order" => 1, + "code" => "depth", + "required" => "true", + "variable" => "true", + "datatype_description" => "an integer", + "description" => "depth of pothole, in centimetres", + "datatype" => "number", + }, + { + "order" => 2, + "code" => "shape", + "variable" => "true", + "datatype_description" => "square | circle | triangle", + "description" => "shape of the pothole", + "required" => "false", + "datatype" => "singlevaluelist", + "values" => [ + { + "name" => "Triangle", + "key" => "triangle" + }, + { + "name" => "Circle", + "key" => "circle" + }, + { + "name" => "Square", + "key" => "square" + } + ], + } + ], + }, 'json structure ok'; +}; + +subtest "POST Service Request validation" => sub { + my $res = $endpoint->run_test_request( + POST => '/requests.json', + ); + ok ! $res->is_success, 'no service_code'; + + $res = $endpoint->run_test_request( + POST => '/requests.json', + service_code => 'BIN', + ); + ok ! $res->is_success, 'no api_key'; + + $res = $endpoint->run_test_request( + POST => '/requests.json', + api_key => 'test', + service_code => 'BADGER', # has moved the goalposts + ); + ok ! $res->is_success, 'bad service_code'; + + $res = $endpoint->run_test_request( + POST => '/requests.json', + api_key => 'test', + service_code => 'POT', + address_string => '22 Acacia Avenue', + first_name => 'Bob', + last_name => 'Mould', + ); + ok ! $res->is_success, 'no required attributes'; + + $res = $endpoint->run_test_request( + POST => '/requests.json', + api_key => 'test', + service_code => 'POT', + address_string => '22 Acacia Avenue', + first_name => 'Bob', + last_name => 'Mould', + 'attribute[depth]' => 100, + 'attribute[shape]' => 'starfish', + ); + ok ! $res->is_success, 'bad attribute'; +}; + +subtest "POST Service Request valid test" => sub { + + set_fixed_time('2014-01-01T12:00:00Z'); + my $res = $endpoint->run_test_request( + POST => '/requests.json', + api_key => 'test', + service_code => 'POT', + address_string => '22 Acacia Avenue', + first_name => 'Bob', + last_name => 'Mould', + 'attribute[depth]' => 100, + 'attribute[shape]' => 'triangle', + ); + ok $res->is_success, 'valid request' + or diag $res->content; + + is_deeply $json->decode($res->content), + [ { + "service_notice" => "This is a test service", + "service_request_id" => 0 + } ], 'correct json returned'; + + set_fixed_time('2014-02-01T12:00:00Z'); + $res = $endpoint->run_test_request( + POST => '/requests.xml', + api_key => 'test', + service_code => 'POT', + address_string => '22 Acacia Avenue', + first_name => 'Bob', + last_name => 'Mould', + 'attribute[depth]' => 100, + 'attribute[shape]' => 'triangle', + ); + + ok $res->is_success, 'valid request' + or diag $res->content; + + is_string $res->content, < + + + This is a test service + 1 + + +CONTENT +}; + +subtest "GET Service Requests" => sub { + + my $res = $endpoint->run_test_request( GET => '/requests.xml', ); + ok $res->is_success, 'valid request'; + my $xml = < + + +
22 Acacia Avenue
+ + 0 + 0 + + 2014-01-01T12:00:00Z + POT + Pothole Repairs + 0 + open + 2014-01-01T12:00:00Z + + + +
22 Acacia Avenue
+ + 0 + 0 + + 2014-02-01T12:00:00Z + POT + Pothole Repairs + 1 + open + 2014-02-01T12:00:00Z + + + +CONTENT + + is_string $res->content, $xml, 'xml string ok'; + + $res = $endpoint->run_test_request( GET => '/requests.xml?service_code=POT', ); + ok $res->is_success, 'valid request'; + + is_string $res->content, $xml, 'xml string ok POT' + or diag $res->content; + + $res = $endpoint->run_test_request( GET => '/requests.xml?service_code=BIN', ); + ok $res->is_success, 'valid request'; + is_string $res->content, < + + +CONTENT +}; + +subtest "GET Service Request" => sub { + my @req=(< + + +
22 Acacia Avenue
+ + 0 + 0 + + 2014-01-01T12:00:00Z + POT + Pothole Repairs + 0 + open + 2014-01-01T12:00:00Z + + + +REQ0 + + + +
22 Acacia Avenue
+ + 0 + 0 + + 2014-02-01T12:00:00Z + POT + Pothole Repairs + 1 + open + 2014-02-01T12:00:00Z + + + +REQ1 + + my $res = $endpoint->run_test_request( GET => '/requests/0.xml', ); + ok $res->is_success, 'valid request'; + + is_string $res->content, $req[0], 'Request 0 ok' + or diag $res->content;; + + $res = $endpoint->run_test_request( GET => '/requests/1.xml', ); + ok $res->is_success, 'valid request'; + + is_string $res->content, $req[1], 'Request 1 ok'; +}; + +restore_time(); +done_testing; diff --git a/t/open311/endpoint/Endpoint1.pm b/t/open311/endpoint/Endpoint1.pm new file mode 100644 index 000000000..ccd16c238 --- /dev/null +++ b/t/open311/endpoint/Endpoint1.pm @@ -0,0 +1,114 @@ +package t::open311::endpoint::Endpoint1; +use Web::Simple; +extends 'Open311::Endpoint'; +use Types::Standard ':all'; +use MooX::HandlesVia; + +use Open311::Endpoint::Service; +use t::open311::endpoint::ServiceType1; +use Open311::Endpoint::Service::Attribute; + +sub services { + return ( + t::open311::endpoint::ServiceType1->new( + service_code => 'POT', + service_name => 'Pothole Repairs', + description => 'Pothole Repairs Service', + attributes => [ + Open311::Endpoint::Service::Attribute->new( + code => 'depth', + required => 1, + datatype => 'number', + datatype_description => 'an integer', + description => 'depth of pothole, in centimetres', + ), + Open311::Endpoint::Service::Attribute->new( + code => 'shape', + required => 0, + datatype => 'singlevaluelist', + datatype_description => 'square | circle | triangle', + description => 'shape of the pothole', + values => { + square => 'Square', + circle => 'Circle', + triangle => 'Triangle', + }, + ), + ], + type => 'realtime', + keywords => [qw/ deep hole wow/], + group => 'highways', + ), + t::open311::endpoint::ServiceType1->new( + service_code => 'BIN', + service_name => 'Bin Enforcement', + description => 'Bin Enforcement Service', + attributes => [], + type => 'realtime', + keywords => [qw/ bin /], + group => 'sanitation', + ) + ); +} + +# FOR TESTING, we'll just maintain requests in a *global* array... +# obviously a real Service driver will use a DB or API call! +{ + our @SERVICE_REQUESTS; + has _requests => ( + is => 'ro', + isa => ArrayRef[ InstanceOf[ 'Open311::Endpoint::Service::Request' ] ], + default => sub { \@SERVICE_REQUESTS }, + handles_via => 'Array', + handles => { + next_request_id => 'count', + _add_request => 'push', + get_request => 'get', + get_requests => 'elements', + filter_requests => 'grep', + } + ); +} + +sub post_service_request { + my ($self, $service, $args) = @_; + + my $request = Open311::Endpoint::Service::Request->new( + + # NB: possible race condition between next_request_id and _add_request + # (this is fine for synchronous test-cases) + + service => $service, + service_request_id => $self->next_request_id, + status => 'open', + description => $args->{description}, + agency_responsible => '', + requested_datetime => DateTime->now(), + updated_datetime => DateTime->now(), + address => $args->{address_string} // '', + address_id => $args->{address_id} // '', + media_url => $args->{media_url} // '', + zipcode => $args->{zipcode} // '', + # NB: other info is passed in that would be stored by an Open311 + # endpoint, see Open311::Endpoint::Service::Request for full list, + # but we don't need to handle all of those in this test + ); + $self->_add_request( $request ); + + return ( $request ); +} + +sub get_service_requests { + my ($self, $args) = @_; + + my $service_code = $args->{service_code} or return $self->get_requests; + # we use ~~ as the service_code arg will be an arrayref like ['POT'] + return $self->filter_requests( sub { shift->service->service_code ~~ $service_code }); +} + +sub get_service_request { + my ($self, $service_request_id, $args) = @_; + return $self->get_request( $service_request_id ); +} + +1; diff --git a/t/open311/endpoint/ServiceType1.pm b/t/open311/endpoint/ServiceType1.pm new file mode 100644 index 000000000..e73b15b7d --- /dev/null +++ b/t/open311/endpoint/ServiceType1.pm @@ -0,0 +1,12 @@ +package t::open311::endpoint::ServiceType1; +use Moo; +extends 'Open311::Endpoint::Service'; +use DateTime; + +use Open311::Endpoint::Service::Request; + +has '+default_service_notice' => ( + default => 'This is a test service', +); + +1; diff --git a/t/open311/endpoint/schema.t b/t/open311/endpoint/schema.t new file mode 100644 index 000000000..b669ca4a5 --- /dev/null +++ b/t/open311/endpoint/schema.t @@ -0,0 +1,82 @@ +use strict; use warnings; + +use Test::More; +use Test::Exception; + +use Data::Rx; +use Open311::Endpoint; + +my $endpoint = Open311::Endpoint->new; +my $schema = $endpoint->rx; + +subtest 'comma tests' => sub { + + dies_ok { + my $comma = $schema->make_schema({ + type => '/open311/comma', + }); + } 'Construction dies on no contents'; + + dies_ok { + my $comma = $schema->make_schema({ + type => '/open311/comma', + contents => '/open311/status', + zirble => 'fleem', + }); + } 'Construction dies on extra arguments'; + + my $comma = $schema->make_schema({ + type => '/open311/comma', + contents => '/open311/status', + trim => 1, + }); + + ok ! $comma->check( undef ), 'Undef is not a valid string'; + ok ! $comma->check( [] ), 'Reference is not a valid string'; + + ok ! $comma->check( 'zibble' ), 'invalid string'; + ok ! $comma->check( 'open,zibble' ), 'an invalid element'; + + ok $comma->check( 'open' ), 'single value'; + ok $comma->check( 'open,closed' ), 'multiple values ok'; + ok $comma->check( 'open, closed ' ), 'spaces trimmed ok'; +}; + +subtest 'datetime tests' => sub { + + dies_ok { + my $comma = $schema->make_schema({ + type => '/open311/datetime', + zirble => 'fleem', + }); + } 'Construction dies on extra keys'; + + my $dt = $schema->make_schema({ + type => '/open311/datetime', + }); + + ok ! $dt->check( undef ), 'Undef is not a valid string'; + ok ! $dt->check( [] ), 'Reference is not a valid string'; + + ok ! $dt->check( '9th Feb 2012' ), 'invalid datetime format'; + + ok $dt->check( '1994-11-05T08:15:30-05:00' ), 'datetime format with offset'; + ok $dt->check( '1994-11-05T08:15:30+05:00' ), 'datetime format with positive'; + ok $dt->check( '1994-11-05T13:15:30Z' ), 'datetime format zulu'; +}; + +subtest 'identifier tests' => sub { + my $id = $schema->make_schema( '/open311/example/identifier' ); + + ok ! $id->check( undef ), 'Undef is not a valid string'; + ok ! $id->check( '' ), 'Empty string is not a valid identifier'; + ok ! $id->check( 'foo bar' ), 'String with spaces is not a valid identifier'; + + ok $id->check( 'foo' ), 'Ascii word string is a valid identifier'; + ok $id->check( 'foo_bar' ), 'Ascii word string is a valid identifier'; + ok $id->check( 'foo_123' ), 'Ascii word/num string is a valid identifier'; +}; + +done_testing; + +1; diff --git a/t/open311/endpoint/spark.t b/t/open311/endpoint/spark.t new file mode 100644 index 000000000..589f39baf --- /dev/null +++ b/t/open311/endpoint/spark.t @@ -0,0 +1,64 @@ +use strict; use warnings; + +use Test::More; + +use Open311::Endpoint; +use Data::Dumper; +use JSON; + +my $endpoint = Open311::Endpoint->new; +my $json = JSON->new; + +subtest "Spark test" => sub { + my $spark = $endpoint->spark; + my $struct = { + foo => { + service_requests => [ 1,2,3 ], + quxes => [ + { + values => [1,2], + }, + { + values => [3,4], + }, + ], + }, + }; + is_deeply $spark->process_for_json($struct), + { + service_requests => [ 1,2,3 ], + quxes => [ + { + values => [1,2], + }, + { + values => [3,4], + }, + ], + }; + + my $xml_struct = $spark->process_for_xml($struct); + is_deeply $xml_struct, + { + foo => { + service_requests => { request => [ 1,2,3 ] }, + quxes => { + quxe => [ + { + values => { + value => [1,2], + }, + }, + { + values => { + value => [3,4], + }, + }, + ] + }, + } + } + or warn Dumper($xml_struct); +}; + +done_testing; -- cgit v1.2.3