Promises-based non-blocking Plack/PSGI app

mx.psgi

#!/usr/bin/env perl
# mx.psgi -- get geographic information about a domain's mailservers

# This was written purely as an example real-world-ish non-blocking
# Plack/PSGI application because I'm sick of seeing the usual
# "Hello World"-esque examples.

# In one shell:
#   $ feersum --listen :5000 -a mx.psgi
#
# And in another shell:
#   $ curl -s http://localhost:5000/google.com | json_xs
#   {
#      "google.com" : {
#         "alt1.aspmx.l.google.com" : {
#            "74.125.30.26" : [
#               "North America",
#               "United States",
#               "Mountain View"
#            ]
#         },
#
#         ...
#
#      }
#   }

use warnings;
use strict;

use AnyEvent;
use AnyEvent::DNS;
use Mojo::JSON;
use Mojo::UserAgent;
use Plack::Request;
use Plack::Response;
use Promises;

my $ua = Mojo::UserAgent->new->max_redirects(5);

sub lookup_mx {
	my ($domain) = @_;
	AE::log trace => "lookup_mx($domain)";

	my $d = Promises::deferred;

	AnyEvent::DNS::mx $domain, sub {
		my (@addrs) = @_;

		if (@addrs) {
			$d->resolve(\@addrs);
			return;
		}

		$d->reject("unable to perform MX lookup of $domain");
	};

	return $d->promise;
}

sub resolve_addr {
	my ($domain) = @_;
	AE::log trace => "resolve_addr($domain)";

	my $d = Promises::deferred;

	AnyEvent::DNS::a $domain, sub {
		my (@addrs) = @_;

		if (@addrs) {
			$d->resolve(\@addrs);
			return;
		}

		$d->reject("unable to resolve $domain");
	};

	return $d->promise;
}

sub ipvigilante {
	my ($address) = @_;
	AE::log trace => "ipvigilante($address)";

	my $d = Promises::deferred;
	my $url = sprintf "https://ipvigilante.com/json/%s", $address;

	$ua->get($url, sub {
		my ($ua, $tx) = @_;
		if ($tx->res->is_success) {
			my $json = $tx->res->json;
			my $rv = [
				$json->{data}->{continent_name},
				$json->{data}->{country_name},
				$json->{data}->{city_name},
			];
			$d->resolve($rv);
			return;
		}
		$d->reject( $tx->res->error );
	} );

	return $d->promise;
}

sub get_ip_informations {
	my ($ips) = @_;

	my $d = Promises::deferred;

	my %rv;
	Promises::collect( map {
			my $ip = $_;
			ipvigilante($ip)
				->then( sub {
					my ($ip_info) = @_;
					$rv{$ip} = $ip_info;
				} )
			} @$ips )
		->then( sub { $d->resolve(\%rv) } )
		->catch( sub { $d->reject(@_) } );

	return $d->promise;
}

sub get_mx_informations {
	my ($addrs) = @_;

	my $d = Promises::deferred;

	my %rv;
	Promises::collect( map {
				my $mx = $_;
				resolve_addr($mx)
					->then( sub { get_ip_informations($_[0]) } )
					->then( sub { $rv{$mx} = $_[0] } );
			} @$addrs )
		->then( sub { $d->resolve(\%rv) } )
		->catch( sub { $d->reject(@_) } );


	return $d->promise;
}

my $app = sub {
	my ($env) = @_;
	my $request = Plack::Request->new($env);

	if ($request->method ne 'GET') {
		return [ 400, [], [] ];
	}

	(my $domain = $request->path_info) =~ s{^/}{};

	if (not $domain) {
		return [
			400,
			[ 'Content-Type' => 'application/json' ],
			[ Mojo::JSON::encode_json( { error => 'domain required' } ) ]
		];
	}

	return sub {
		my ($responder) = @_;
		my $response = Plack::Response->new;

		lookup_mx($domain)
			->then( sub { get_mx_informations($_[0]) } )
			->then( sub {
					my ($mx_informations) = @_;
					$response->status(200);
					return { $domain => $mx_informations };
				} )
			->catch( sub {
					my ($error) = @_;
					$response->status(400);
					return { error => $error };
				} )
			->finally( sub {
					my ($json) = @_;
					$response->headers( [
						'Content-Type' => 'application/json'
					] );
					$response->body( Mojo::JSON::encode_json($json) );
					$responder->( $response->finalize )
				} );
	}
};