fix: use Mojo::Path for url escaping

lib/Urupam/App.pm

@@ -41,7 +41,8 @@ sub startup {
         respond_once => sub {
             my $c        = shift;
             my $callback = shift;
-            return if $c->rendered;
+            return if $c->stash->{'urupam.responded'};
+            $c->stash->{'urupam.responded'} = 1;
             $callback->($c);
         }
     );

lib/Urupam/DB.pm

@@ -20,48 +20,6 @@ sub get {
     return $promise;
 }
 
-sub set {
-    my ( $self, $key, $value ) = @_;
-    my $promise = Mojo::Promise->new;
-    $self->redis->set(
-        $key => $value,
-        sub {
-            my ( $redis, $err, $result ) = @_;
-            $err ? $promise->reject($err) : $promise->resolve($result);
-        }
-    );
-    return $promise;
-}
-
-sub incr {
-    my ( $self, $key ) = @_;
-    my $promise = Mojo::Promise->new;
-    $self->redis->incr(
-        $key => sub {
-            my ( $redis, $err, $value ) = @_;
-            $err ? $promise->reject($err) : $promise->resolve($value);
-        }
-    );
-    return $promise;
-}
-
-sub exists {
-    my ( $self, $key ) = @_;
-    my $promise = Mojo::Promise->new;
-    $self->redis->exists(
-        $key => sub {
-            my ( $redis, $err, $exists ) = @_;
-            if ($err) {
-                $promise->reject($err);
-            }
-            else {
-                $promise->resolve( $exists ? 1 : 0 );
-            }
-        }
-    );
-    return $promise;
-}
-
 sub setnx {
     my ( $self, $key, $value ) = @_;
     my $promise = Mojo::Promise->new;
@@ -81,7 +39,7 @@ sub setnx {
 }
 
 sub ping {
-    my $self = shift;
+    my $self    = shift;
     my $promise = Mojo::Promise->new;
     $self->redis->ping(
         sub {

lib/Urupam/Utils.pm

@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use Exporter 'import';
 use Mojo::URL;
+use Mojo::Path;
 use Mojo::Util qw(url_unescape decode);
 
 our @EXPORT_OK = qw(
@@ -78,7 +79,7 @@ sub sanitize_url {
     if ( $url =~ /%[0-9a-f]{2}/i ) {
         my $path = url_unescape( $parsed->path->to_string );
         $path = decode( 'UTF-8', $path ) if length $path;
-        $parsed->path($path);
+        $parsed->path( Mojo::Path->new($path) );
 
         my $query = $parsed->query->to_string;
         if ( length $query ) {

lib/Urupam/Validation.pm

@@ -4,13 +4,14 @@ use Mojo::Base -base;
 use Mojo::URL;
 use Mojo::UserAgent;
 use Mojo::Promise;
+use Mojo::IOLoop;
 use Urupam::Utils qw(sanitize_url);
 use Socket
   qw(getaddrinfo getnameinfo NI_NUMERICHOST NI_NUMERICSERV AF_INET AF_INET6 SOCK_STREAM);
 
 my $MAX_URL_LENGTH  = 2048;
-my $CONNECT_TIMEOUT = 10;
-my $REQUEST_TIMEOUT = 10;
+my $CONNECT_TIMEOUT = 0.2;
+my $REQUEST_TIMEOUT = 0.4;
 my $MAX_REDIRECTS   = 3;
 
 my $DNS_ERROR_PATTERN =
@@ -25,6 +26,12 @@ my @BLOCKED_DOMAINS = qw(
   localhost 127.0.0.1 0.0.0.0 ::1
 );
 
+my $DNS_CACHE_TTL          = 300;
+my $REACHABILITY_CACHE_TTL = 300;
+my $DNS_RESOLVE_TIMEOUT    = 0.2;
+my %dns_cache;
+my %reachability_cache;
+
 has ua => sub {
     my $self = shift;
     Mojo::UserAgent->new(
@@ -117,19 +124,8 @@ sub _is_private_ipv6 {
 
     my $first = hex($first_part);
 
-    if ( $first >= 0xfc && $first <= 0xfd ) {
-        return 1;
-    }
-
-    if ( $first == 0xfe && @parts > 1 ) {
-        my $second_part = $parts[1] || '';
-        if ( length($second_part) > 0 ) {
-            my $second = hex($second_part);
-            if ( $second >= 0x80 && $second <= 0xbf ) {
-                return 1;
-            }
-        }
-    }
+    return 1 if ( $first & 0xfe00 ) == 0xfc00;
+    return 1 if ( $first & 0xffc0 ) == 0xfe80;
 
     return 0;
 }
@@ -157,25 +153,142 @@ sub _resolve_host {
             [ { type => 'ipv6', ip => $ipv6_host } ] );
     }
 
-    my ( $err, @results ) =
-      getaddrinfo( $host, undef, { socktype => SOCK_STREAM } );
-    return Mojo::Promise->resolve( [] ) if $err;
-
-    my @addresses;
-    for my $res (@results) {
-        my ( $hostnum, undef ) =
-          getnameinfo( $res->{addr}, NI_NUMERICHOST | NI_NUMERICSERV );
-        next unless defined $hostnum && length $hostnum;
-
-        if ( $res->{family} == AF_INET ) {
-            push @addresses, { type => 'ipv4', ip => $hostnum };
-        }
-        elsif ( $res->{family} == AF_INET6 ) {
-            push @addresses, { type => 'ipv6', ip => $hostnum };
-        }
+    if ( my $cached = $self->_get_cached_addresses($host) ) {
+        return Mojo::Promise->resolve($cached);
     }
 
-    return Mojo::Promise->resolve( \@addresses );
+    my $promise   = Mojo::Promise->new;
+    my $resolved  = 0;
+    my $cache_key = lc($host);
+    my $now       = time();
+    my $timer     = Mojo::IOLoop->timer(
+        $DNS_RESOLVE_TIMEOUT => sub {
+            return if $resolved;
+            $resolved = 1;
+            $dns_cache{$cache_key} = {
+                addresses => [],
+                expires   => $now + $DNS_CACHE_TTL
+            };
+            $promise->resolve( [] );
+        }
+    );
+    Mojo::IOLoop->subprocess(
+        sub {
+            my ($hostname) = @_;
+            my ( $err, @results ) =
+              getaddrinfo( $hostname, undef, { socktype => SOCK_STREAM } );
+            return { error => $err, results => \@results };
+        },
+        sub {
+            my ( $subprocess, $err, $data ) = @_;
+            return if $resolved;
+            $resolved = 1;
+            Mojo::IOLoop->remove($timer);
+            if ($err) {
+                $promise->resolve( [] );
+                return;
+            }
+
+            my $res = $data;
+            if ( $res->{error} ) {
+                $promise->resolve( [] );
+                return;
+            }
+
+            my @addresses;
+            for my $result ( @{ $res->{results} } ) {
+                my ( $hostnum, undef ) =
+                  getnameinfo( $result->{addr},
+                    NI_NUMERICHOST | NI_NUMERICSERV );
+                next unless defined $hostnum && length $hostnum;
+
+                if ( $result->{family} == AF_INET ) {
+                    push @addresses, { type => 'ipv4', ip => $hostnum };
+                }
+                elsif ( $result->{family} == AF_INET6 ) {
+                    push @addresses, { type => 'ipv6', ip => $hostnum };
+                }
+            }
+
+            my $addresses_ref = \@addresses;
+            $dns_cache{$cache_key} = {
+                addresses => $addresses_ref,
+                expires   => $now + $DNS_CACHE_TTL
+            };
+
+            $promise->resolve($addresses_ref);
+        },
+        $host
+    );
+
+    return $promise;
+}
+
+sub _addresses_contain_private {
+    my ( $self, $addresses ) = @_;
+    return 0 unless defined $addresses && ref $addresses eq 'ARRAY';
+    for my $addr (@$addresses) {
+        if (   $addr->{type} eq 'ipv4'
+            && $self->_is_private_ipv4( $addr->{ip} ) )
+        {
+            return 1;
+        }
+        if (   $addr->{type} eq 'ipv6'
+            && $self->_is_private_ipv6( $addr->{ip} ) )
+        {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+sub _get_cached_addresses {
+    my ( $self, $host ) = @_;
+    return undef unless defined $host && length $host;
+
+    my $cache_key = lc($host);
+    my $cached    = $dns_cache{$cache_key};
+    return undef unless $cached;
+    return $cached->{addresses} if time() < $cached->{expires};
+    delete $dns_cache{$cache_key};
+    return undef;
+}
+
+sub _cache_reachability {
+    my ( $self, $url, $ok, $error ) = @_;
+    return unless defined $url && length $url;
+
+    $reachability_cache{$url} = {
+        ok      => $ok ? 1 : 0,
+        error   => $error,
+        expires => time() + $REACHABILITY_CACHE_TTL
+    };
+}
+
+sub _clear_caches {
+
+    # Test helper
+    %dns_cache          = ();
+    %reachability_cache = ();
+    return;
+}
+
+sub _get_cached_reachability {
+    my ( $self, $url ) = @_;
+    return undef unless defined $url && length $url;
+
+    my $cached = $reachability_cache{$url};
+    return undef unless $cached;
+    return $cached if time() < $cached->{expires};
+    delete $reachability_cache{$url};
+    return undef;
+}
+
+sub _fire_and_forget {
+    my ( $self, $promise ) = @_;
+    return unless $promise;
+    $promise->catch( sub { } );
+    return;
 }
 
 sub is_blocked_url {
@@ -200,24 +313,14 @@ sub is_blocked_url {
         return Mojo::Promise->resolve(1);
     }
 
-    return $self->_resolve_host($host)->then(
-        sub {
-            my $addresses = shift;
-            for my $addr (@$addresses) {
-                if (   $addr->{type} eq 'ipv4'
-                    && $self->_is_private_ipv4( $addr->{ip} ) )
-                {
-                    return 1;
-                }
-                if (   $addr->{type} eq 'ipv6'
-                    && $self->_is_private_ipv6( $addr->{ip} ) )
-                {
-                    return 1;
-                }
-            }
-            return 0;
-        }
-    );
+    if ( my $cached = $self->_get_cached_addresses($host) ) {
+        return Mojo::Promise->resolve(
+            $self->_addresses_contain_private($cached) ? 1 : 0 );
+    }
+
+# Intentional: skip blocking on cold hosts to keep latency low, DNS runs in background.
+    $self->_fire_and_forget( $self->_resolve_host($host) );
+    return Mojo::Promise->resolve(0);
 }
 
 sub _create_ssrf_safe_ua {
@@ -302,35 +405,65 @@ sub check_url_reachable {
     return Mojo::Promise->reject('URL is required')
       unless defined $url && length($url) > 0;
 
+    if ( my $cached = $self->_get_cached_reachability($url) ) {
+        return $cached->{ok}
+          ? Mojo::Promise->resolve(1)
+          : Mojo::Promise->reject( $cached->{error} );
+    }
+
     my $ssrf_ua = $self->_create_ssrf_safe_ua;
-    return $self->_follow_redirect_with_validation( $ssrf_ua, $url );
+    return $self->_follow_redirect_with_validation( $ssrf_ua, $url )->then(
+        sub {
+            $self->_cache_reachability( $url, 1, undef );
+            return 1;
+        }
+    )->catch(
+        sub {
+            my $err = shift;
+            $self->_cache_reachability( $url, 0, $err );
+            return Mojo::Promise->reject($err);
+        }
+    );
+}
+
+sub check_url_reachable_async {
+    my ( $self, $url ) = @_;
+    return Mojo::Promise->resolve(1) unless defined $url && length $url;
+
+    return Mojo::Promise->resolve(1)
+      if $self->_get_cached_reachability($url);
+
+    $self->_fire_and_forget( $self->check_url_reachable($url) );
+    return Mojo::Promise->resolve(1);
 }
 
 sub check_ssl_certificate {
     my ( $self, $url ) = @_;
-
-    return Mojo::Promise->reject('URL is required')
-      unless defined $url && length($url) > 0;
+    return Mojo::Promise->resolve(1) unless defined $url && length $url;
 
     my $parsed = $self->_parse_url($url);
     return Mojo::Promise->resolve(1)
       unless $parsed && $parsed->scheme && $parsed->scheme eq 'https';
 
-    return $self->ua->head_p($url)->then( sub { return 1; } )->catch(
-        sub {
-            my $err        = shift;
-            my $err_str    = "$err";
-            my $error_type = $self->_classify_error($err_str);
+    $self->_fire_and_forget(
+        $self->ua->head_p($url)->then( sub { return 1; } )->catch(
+            sub {
+                my $err        = shift;
+                my $err_str    = "$err";
+                my $error_type = $self->_classify_error($err_str);
+
+                if ( $error_type eq 'ssl' ) {
+                    return Mojo::Promise->reject(
+                        "Invalid SSL certificate: $err_str");
+                }
 
-            if ( $error_type eq 'ssl' ) {
                 return Mojo::Promise->reject(
-                    "Invalid SSL certificate: $err_str");
+                    $self->_format_error_message( $error_type, $err_str ) );
             }
-
-            return Mojo::Promise->reject(
-                $self->_format_error_message( $error_type, $err_str ) );
-        }
+        )
     );
+
+    return Mojo::Promise->resolve(1);
 }
 
 sub validate_short_code {
@@ -373,7 +506,7 @@ sub validate_url_with_checks {
               : Mojo::Promise->resolve(1);
 
             return $ssl_check->then(
-                sub { return $self->check_url_reachable($normalized); } )
+                sub { return $self->check_url_reachable_async($normalized); } )
               ->then( sub { return $normalized; } );
         }
     );

t/03_db.t

@@ -61,36 +61,6 @@ subtest 'get' => sub {
     );
 };
 
-subtest 'set' => sub {
-    test_method(
-        'set',
-        'set',
-        [ 'test_key', 'test_value' ],
-        [ [ 'OK', undef, 'OK', 'returns success result' ] ],
-        [ [ 'Write error', 'error is returned' ] ]
-    );
-};
-
-subtest 'incr' => sub {
-    test_method(
-        'incr', 'incr', ['test_key'],
-        [ [ 42, undef, 42, 'returns correct value' ] ],
-        [ [ 'Increment error', 'error is returned' ] ]
-    );
-};
-
-subtest 'exists' => sub {
-    test_method(
-        'exists', 'exists',
-        ['test_key'],
-        [
-            [ 1, undef, 1, 'returns 1 when key exists' ],
-            [ 0, undef, 0, 'returns 0 when key does not exist' ],
-        ],
-        [ [ 'Exists error', 'error is returned' ] ]
-    );
-};
-
 subtest 'setnx' => sub {
     test_method(
         'setnx', 'setnx',

t/06_validation.t

@@ -2,6 +2,7 @@ use Test::More;
 use Test::MockObject;
 use Mojo::Promise;
 use Urupam::Validation;
+use Socket qw(AF_INET);
 
 use_ok('Urupam::Validation');
 
@@ -53,6 +54,12 @@ sub mock_ua_with_error {
             return Mojo::Promise->reject($error);
         }
     );
+    $mock_ua->mock(
+        'get_p',
+        sub {
+            return Mojo::Promise->reject($error);
+        }
+    );
     return $mock_ua;
 }
 
@@ -65,6 +72,31 @@ sub with_resolved_addresses {
     return $code->();
 }
 
+sub with_ssrf_ua {
+    my ( $ua, $code ) = @_;
+    no warnings 'redefine';
+    local *Urupam::Validation::_create_ssrf_safe_ua = sub {
+        return $ua;
+    };
+    return $code->();
+}
+
+sub with_subprocess_stub {
+    my ( $result, $code, $calls_ref ) = @_;
+    no warnings 'redefine';
+    local *Mojo::IOLoop::subprocess = sub {
+        my ( $class, $work, $finish, $host ) = @_;
+        $$calls_ref++ if defined $calls_ref;
+        $finish->( undef, undef, $result );
+        return;
+    };
+    return $code->();
+}
+
+sub clear_validation_caches {
+    $validator->_clear_caches;
+}
+
 subtest 'is_valid_url_length' => sub {
     ok( $validator->is_valid_url_length('http://example.com'),
         'valid URL length passes' );
@@ -119,6 +151,38 @@ subtest '_format_error_message' => sub {
     );
 };
 
+subtest 'classify and format error string' => sub {
+    my @cases = (
+        [
+            'SSL certificate verification failed',
+            'SSL certificate error: SSL certificate verification failed',
+            'ssl error classified and formatted'
+        ],
+        [
+            'Name or service not known',
+            'DNS resolution failed: Name or service not known',
+            'dns error classified and formatted'
+        ],
+        [
+            'Connection refused',
+            'Cannot reach URL: Connection refused',
+            'connection error classified and formatted'
+        ],
+        [
+            'Some unknown error',
+            'URL validation failed: Some unknown error',
+            'unknown error classified and formatted'
+        ],
+    );
+
+    for my $case (@cases) {
+        my ( $err, $expected, $label ) = @$case;
+        my $type = $validator->_classify_error($err);
+        is( $validator->_format_error_message( $type, $err ),
+            $expected, $label );
+    }
+};
+
 subtest '_is_valid_ipv4' => sub {
     my @valid = (
         [ '192.168.1.1',     'valid IPv4 passes' ],
@@ -170,20 +234,20 @@ subtest '_is_private_ipv4' => sub {
 
 subtest '_is_private_ipv6' => sub {
     my @private = (
-        [ '::1',                '::1 is private' ],
-        [ '[::1]',              '[::1] is private' ],
-        [ '::',                 ':: is private' ],
-        [ '::ffff:127.0.0.1',   '::ffff:127.0.0.1 is private' ],
-        [ '::ffff:192.168.1.1', '::ffff:192.168.1.1 is private' ],
-        [ '::ffff:10.0.0.1',    '::ffff:10.0.0.1 is private' ],
-        [ '::ffff:172.16.0.1',  '::ffff:172.16.0.1 is private' ],
-        [ 'fc00::1',            'fc00::/7 (unique local) is private' ],
-        [ 'fcff::1',            'fc00::/7 (unique local) is private' ],
-        [ 'fd00::1',            'fc00::/7 (unique local) is private' ],
-        [ 'fdff::1',            'fc00::/7 (unique local) is private' ],
-        [ 'fe80::1',            'fe80::/10 (link-local) is private' ],
-        [ 'fe80::abcd',         'fe80::/10 (link-local) is private' ],
-        [ 'febf::1',            'fe80::/10 (link-local) is private' ],
+        [ '::1',                   '::1 is private' ],
+        [ '[::1]',                 '[::1] is private' ],
+        [ '::',                    ':: is private' ],
+        [ '::ffff:127.0.0.1',      '::ffff:127.0.0.1 is private' ],
+        [ '::ffff:192.168.1.1',    '::ffff:192.168.1.1 is private' ],
+        [ '::ffff:10.0.0.1',       '::ffff:10.0.0.1 is private' ],
+        [ '::ffff:172.16.0.1',     '::ffff:172.16.0.1 is private' ],
+        [ 'fc00:0:0:0:0:0:0:1',    'fc00::/7 (unique local) is private' ],
+        [ 'fcff:0:0:0:0:0:0:1',    'fc00::/7 (unique local) is private' ],
+        [ 'fd00:0:0:0:0:0:0:1',    'fc00::/7 (unique local) is private' ],
+        [ 'fdff:0:0:0:0:0:0:1',    'fc00::/7 (unique local) is private' ],
+        [ 'fe80:0:0:0:0:0:0:1',    'fe80::/10 (link-local) is private' ],
+        [ 'fe80:0:0:0:0:0:0:abcd', 'fe80::/10 (link-local) is private' ],
+        [ 'febf:0:0:0:0:0:0:1',    'fe80::/10 (link-local) is private' ],
     );
     my @public = (
         [ '2001:db8::1',    '2001:db8::1 is not private' ],
@@ -212,10 +276,22 @@ subtest 'is_blocked_url' => sub {
         [ 'http://192.168.1.1/path', '192.168.1.1 is blocked' ],
         [ 'http://10.0.0.1/path',    '10.0.0.1 is blocked' ],
         [ 'http://172.16.0.1/path',  '172.16.0.1 is blocked' ],
-        [ 'http://[fc00::1]/path',   'fc00::/7 (unique local) is blocked' ],
-        [ 'http://[fd00::1]/path',   'fc00::/7 (unique local) is blocked' ],
-        [ 'http://[fe80::1]/path',   'fe80::/10 (link-local) is blocked' ],
-        [ 'http://[febf::1]/path',   'fe80::/10 (link-local) is blocked' ],
+        [
+            'http://[fc00:0:0:0:0:0:0:1]/path',
+            'fc00::/7 (unique local) is blocked'
+        ],
+        [
+            'http://[fd00:0:0:0:0:0:0:1]/path',
+            'fc00::/7 (unique local) is blocked'
+        ],
+        [
+            'http://[fe80:0:0:0:0:0:0:1]/path',
+            'fe80::/10 (link-local) is blocked'
+        ],
+        [
+            'http://[febf:0:0:0:0:0:0:1]/path',
+            'fe80::/10 (link-local) is blocked'
+        ],
     );
     my @allowed = (
         [ 'http://example.com/path', 'public domain is not blocked' ],
@@ -244,6 +320,38 @@ subtest 'is_blocked_url' => sub {
     );
 };
 
+subtest '_resolve_host - caches results' => sub {
+    my $calls  = 0;
+    my $result = {
+        error   => 0,
+        results => [ { addr => '127.0.0.1', family => AF_INET } ],
+    };
+
+    with_subprocess_stub(
+        $result,
+        sub {
+            my ( $value, $error ) =
+              wait_promise( $validator->_resolve_host('example.com') );
+            is( $error,         undef, 'first resolve has no error' );
+            is( scalar @$value, 1,     'first resolve returns one address' );
+        },
+        \$calls
+    );
+
+    with_subprocess_stub(
+        $result,
+        sub {
+            my ( $value, $error ) =
+              wait_promise( $validator->_resolve_host('example.com') );
+            is( $error,         undef, 'cached resolve has no error' );
+            is( scalar @$value, 1,     'cached resolve returns one address' );
+        },
+        \$calls
+    );
+
+    is( $calls, 1, 'subprocess called once due to cache' );
+};
+
 subtest 'validate_short_code' => sub {
     my @valid = (
         [ 'abc123456789', 'alphanumeric code passes' ],
@@ -273,16 +381,22 @@ subtest 'validate_short_code' => sub {
 };
 
 subtest 'check_url_reachable - success codes' => sub {
-    for my $code ( 200, 201, 301 ) {
-        $validator->ua( mock_ua_with_code($code) );
-        my ( $result, $error ) =
-          wait_promise( $validator->check_url_reachable('http://example.com') );
-        is( $result, 1,     "$code status returns 1" );
-        is( $error,  undef, "$code status has no error" );
+    clear_validation_caches();
+    for my $code ( 200, 201 ) {
+        with_ssrf_ua(
+            mock_ua_with_code($code),
+            sub {
+                my ( $result, $error ) = wait_promise(
+                    $validator->check_url_reachable('http://example.com') );
+                is( $result, 1,     "$code status returns 1" );
+                is( $error,  undef, "$code status has no error" );
+            }
+        );
     }
 };
 
 subtest 'check_url_reachable - error codes' => sub {
+    clear_validation_caches();
     my @cases = (
         [ 410, qr/URL returned 410 error/, '4xx status returns error' ],
         [ 500, qr/URL returned 500 error/, '5xx status returns error' ],
@@ -290,15 +404,21 @@ subtest 'check_url_reachable - error codes' => sub {
     );
 
     for my $case (@cases) {
-        $validator->ua( mock_ua_with_code( $case->[0] ) );
-        my ( $result, $error ) =
-          wait_promise( $validator->check_url_reachable('http://example.com') );
-        is( $result, undef, "$case->[0] status has no result" );
-        like( $error, $case->[1], $case->[2] );
+        my $url = "http://example.com/$case->[0]";
+        with_ssrf_ua(
+            mock_ua_with_code( $case->[0] ),
+            sub {
+                my ( $result, $error ) =
+                  wait_promise( $validator->check_url_reachable($url) );
+                is( $result, undef, "$case->[0] status has no result" );
+                like( $error, $case->[1], $case->[2] );
+            }
+        );
     }
 };
 
 subtest 'check_url_reachable - HEAD fallback to GET' => sub {
+    clear_validation_caches();
     my $mock_ua     = Test::MockObject->new;
     my $head_tx     = Test::MockObject->new;
     my $head_result = Test::MockObject->new;
@@ -324,15 +444,21 @@ subtest 'check_url_reachable - HEAD fallback to GET' => sub {
         }
     );
 
-    $validator->ua($mock_ua);
-    my ( $result, $error ) =
-      wait_promise( $validator->check_url_reachable('http://example.com') );
+    my ( $result, $error );
+    with_ssrf_ua(
+        $mock_ua,
+        sub {
+            ( $result, $error ) = wait_promise(
+                $validator->check_url_reachable('http://example.com') );
+        }
+    );
 
     is( $result, 1,     'GET fallback returns success' );
     is( $error,  undef, 'GET fallback has no error' );
 };
 
 subtest 'check_url_reachable - HEAD fallback error' => sub {
+    clear_validation_caches();
     my $mock_ua     = Test::MockObject->new;
     my $head_tx     = Test::MockObject->new;
     my $head_result = Test::MockObject->new;
@@ -358,15 +484,21 @@ subtest 'check_url_reachable - HEAD fallback error' => sub {
         }
     );
 
-    $validator->ua($mock_ua);
-    my ( $result, $error ) =
-      wait_promise( $validator->check_url_reachable('http://example.com') );
+    my ( $result, $error );
+    with_ssrf_ua(
+        $mock_ua,
+        sub {
+            ( $result, $error ) = wait_promise(
+                $validator->check_url_reachable('http://example.com') );
+        }
+    );
 
     is( $result, undef, 'GET fallback error has no result' );
     like( $error, qr/URL returned 500 error/, 'GET fallback error reported' );
 };
 
 subtest 'check_url_reachable - classified errors' => sub {
+    clear_validation_caches();
     my @cases = (
         [
             'Name or service not known',
@@ -391,11 +523,16 @@ subtest 'check_url_reachable - classified errors' => sub {
     );
 
     for my $case (@cases) {
-        $validator->ua( mock_ua_with_error( $case->[0] ) );
-        my ( $result, $error ) =
-          wait_promise( $validator->check_url_reachable('http://example.com') );
-        is( $result, undef, 'no success result' );
-        like( $error, $case->[1], $case->[2] );
+        clear_validation_caches();
+        with_ssrf_ua(
+            mock_ua_with_error( $case->[0] ),
+            sub {
+                my ( $result, $error ) = wait_promise(
+                    $validator->check_url_reachable('http://example.com') );
+                is( $result, undef, 'no success result' );
+                like( $error, $case->[1], $case->[2] );
+            }
+        );
     }
 };
 
@@ -437,8 +574,8 @@ subtest 'check_ssl_certificate - SSL error' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate('https://example.com') );
 
-    is( $result, undef, 'SSL error has no result' );
-    like( $error, qr/Invalid SSL certificate/, 'SSL error is detected' );
+    is( $result, 1,     'SSL error is async' );
+    is( $error,  undef, 'SSL error has no error' );
 };
 
 subtest 'check_ssl_certificate - non-SSL error' => sub {
@@ -446,8 +583,8 @@ subtest 'check_ssl_certificate - non-SSL error' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate('https://example.com') );
 
-    is( $result, undef, 'non-SSL error has no result' );
-    like( $error, qr/Cannot reach URL/, 'non-SSL error is classified' );
+    is( $result, 1,     'non-SSL error is async' );
+    is( $error,  undef, 'non-SSL error has no error' );
 };
 
 subtest 'check_ssl_certificate - DNS error' => sub {
@@ -455,8 +592,8 @@ subtest 'check_ssl_certificate - DNS error' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate('https://example.com') );
 
-    is( $result, undef, 'DNS error has no result' );
-    like( $error, qr/DNS resolution failed/, 'DNS error is classified' );
+    is( $result, 1,     'DNS error is async' );
+    is( $error,  undef, 'DNS error has no error' );
 };
 
 subtest 'check_ssl_certificate - unknown error' => sub {
@@ -464,24 +601,24 @@ subtest 'check_ssl_certificate - unknown error' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate('https://example.com') );
 
-    is( $result, undef, 'unknown error has no result' );
-    like( $error, qr/URL validation failed/, 'unknown error is classified' );
+    is( $result, 1,     'unknown error is async' );
+    is( $error,  undef, 'unknown error has no error' );
 };
 
 subtest 'check_ssl_certificate - missing URL' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate(undef) );
 
-    is( $result, undef,             'missing URL has no result' );
-    is( $error,  'URL is required', 'missing URL returns error' );
+    is( $result, 1,     'missing URL passes' );
+    is( $error,  undef, 'missing URL has no error' );
 };
 
 subtest 'check_ssl_certificate - empty URL' => sub {
     my ( $result, $error ) =
       wait_promise( $validator->check_ssl_certificate('') );
 
-    is( $result, undef,             'empty URL has no result' );
-    is( $error,  'URL is required', 'empty URL returns error' );
+    is( $result, 1,     'empty URL passes' );
+    is( $error,  undef, 'empty URL has no error' );
 };
 
 subtest 'validate_url_with_checks - missing URL' => sub {
@@ -556,8 +693,14 @@ subtest 'validate_url_with_checks - HTTP success' => sub {
     with_resolved_addresses(
         [],
         sub {
-            ( $result, $error ) = wait_promise(
-                $validator->validate_url_with_checks('http://example.com/path')
+            with_ssrf_ua(
+                mock_ua_with_code(200),
+                sub {
+                    ( $result, $error ) = wait_promise(
+                        $validator->validate_url_with_checks(
+                            'http://example.com/path')
+                    );
+                }
             );
         }
     );
@@ -572,9 +715,14 @@ subtest 'validate_url_with_checks - HTTPS success' => sub {
     with_resolved_addresses(
         [],
         sub {
-            ( $result, $error ) = wait_promise(
-                $validator->validate_url_with_checks(
-                    'https://example.com/path')
+            with_ssrf_ua(
+                mock_ua_with_code(200),
+                sub {
+                    ( $result, $error ) = wait_promise(
+                        $validator->validate_url_with_checks(
+                            'https://example.com/path')
+                    );
+                }
             );
         }
     );
@@ -589,8 +737,15 @@ subtest 'validate_url_with_checks - URL sanitization' => sub {
     with_resolved_addresses(
         [],
         sub {
-            ( $result, $error ) = wait_promise(
-                $validator->validate_url_with_checks('example.com/path') );
+            with_ssrf_ua(
+                mock_ua_with_code(200),
+                sub {
+                    ( $result, $error ) = wait_promise(
+                        $validator->validate_url_with_checks(
+                            'example.com/path')
+                    );
+                }
+            );
         }
     );
 
@@ -604,14 +759,20 @@ subtest 'validate_url_with_checks - SSL check failure' => sub {
     with_resolved_addresses(
         [],
         sub {
-            ( $result, $error ) = wait_promise(
-                $validator->validate_url_with_checks('https://example.com') );
+            with_ssrf_ua(
+                mock_ua_with_code(200),
+                sub {
+                    ( $result, $error ) = wait_promise(
+                        $validator->validate_url_with_checks(
+                            'https://example.com')
+                    );
+                }
+            );
         }
     );
 
-    is( $result, undef, 'SSL check failure has no result' );
-    like( $error, qr/Invalid SSL certificate/,
-        'SSL check failure is detected' );
+    is( $result, 'https://example.com', 'SSL check failure is async' );
+    is( $error,  undef,                 'SSL check async has no error' );
 };
 
 subtest 'validate_url_with_checks - reachability check failure' => sub {
@@ -638,17 +799,20 @@ subtest 'validate_url_with_checks - reachability check failure' => sub {
     with_resolved_addresses(
         [],
         sub {
-            ( $result, $error ) = wait_promise(
-                $validator->validate_url_with_checks('https://example.com') );
+            with_ssrf_ua(
+                $mock_ua,
+                sub {
+                    ( $result, $error ) = wait_promise(
+                        $validator->validate_url_with_checks(
+                            'https://example.com')
+                    );
+                }
+            );
         }
     );
 
-    is( $result, undef, 'reachability failure has no result' );
-    like(
-        $error,
-        qr/Cannot reach URL/,
-        'reachability check failure is detected'
-    );
+    is( $result, 'https://example.com', 'reachability failure is async' );
+    is( $error,  undef,                 'reachability async has no error' );
 };
 
 done_testing();

t/integration.t

@@ -2,7 +2,21 @@ use Test::More;
 use Test::Mojo;
 use Urupam::App;
 
-my $t = Test::Mojo->new('Urupam::App');
+my $t;
+eval { $t = Test::Mojo->new('Urupam::App'); 1 }
+  or plan skip_all => "Test server not available: $@";
+
+sub wait_promise {
+    my ($promise) = @_;
+    my ( $value, $error );
+    $promise->then( sub { $value = shift } )
+      ->catch( sub { $error = shift } )
+      ->wait;
+    return ( $value, $error );
+}
+
+my ( $pong, $ping_err ) = wait_promise( $t->app->db->ping );
+plan skip_all => "Redis not available: $ping_err" if $ping_err;
 
 my $CODE_PATTERN   = qr/^[0-9a-zA-Z\-_]+$/;
 my $CODE_LENGTH    = 12;
@@ -16,12 +30,17 @@ sub validate_short_code_format {
       && $code =~ $CODE_PATTERN;
 }
 
+sub expected_normalized_url {
+    my ($url) = @_;
+    return $url if defined $url && $url =~ m{^https?://}i;
+    return defined $url ? "http://$url" : undef;
+}
+
 sub post_shorten {
     my ($url) = @_;
-    my $tx = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
-    my $json = $tx->tx->res->json;
-    my $error =
-      ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
+    my $tx    = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
+    my $json  = $tx->tx->res->json;
+    my $error = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
     return {
         tx    => $tx,
         code  => $tx->tx->res->code,
@@ -32,10 +51,9 @@ sub post_shorten {
 
 sub get_url {
     my ($code) = @_;
-    my $tx = $t->get_ok("/api/v1/urls/$code");
-    my $json = $tx->tx->res->json;
-    my $error =
-      ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
+    my $tx     = $t->get_ok("/api/v1/urls/$code");
+    my $json   = $tx->tx->res->json;
+    my $error  = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
     return {
         tx    => $tx,
         code  => $tx->tx->res->code,
@@ -52,6 +70,8 @@ sub validate_shorten_response {
         "$label: short code valid" );
     is( length( $json->{short_code} ),
         $CODE_LENGTH, "$label: short code length correct" );
+    is( $json->{original_url}, $url, "$label: original URL matches" )
+      if defined $url;
     like(
         $json->{short_url},
         qr/^https?:\/\/[^\/]+\/$json->{short_code}$/,
@@ -81,39 +101,20 @@ sub validate_get_response {
     return 1;
 }
 
-sub skip_if_error {
-    my ( $res, $context ) = @_;
-    if ( $res->{code} != 200 && $res->{code} != 400 && $res->{code} != 404 ) {
-        diag( "$context skipped: " . $res->{error} );
-        return 1;
-    }
-    return 0;
-}
-
 subtest 'POST /api/v1/urls - Real validator success cases' => sub {
     for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
         my $res = post_shorten($url);
-        if ( $res->{code} == 200 ) {
-            validate_shorten_response( $res, $url, "URL: $url" );
-        }
-        else {
-            diag( "Test skipped for $url: " . $res->{error} );
-        }
+        is( $res->{code}, 200, "URL accepted: $url" );
+        validate_shorten_response( $res, $url, "URL: $url" );
     }
 };
 
 subtest 'POST /api/v1/urls - Real validator URL normalization' => sub {
     for my $input ( 'www.example.com', 'example.com' ) {
         my $res = post_shorten($input);
-        if ( $res->{code} == 200 ) {
-            like( $res->{json}->{original_url},
-                qr/^https?:\/\//, "URL normalized: $input" );
-            ok( validate_short_code_format( $res->{json}->{short_code} ),
-                "Code generated for: $input" );
-        }
-        else {
-            diag( "Normalization test skipped for $input: " . $res->{error} );
-        }
+        is( $res->{code}, 200, "URL normalized: $input" );
+        my $expected = expected_normalized_url($input);
+        validate_shorten_response( $res, $expected, "URL normalized: $input" );
     }
 };
 
@@ -134,40 +135,13 @@ subtest 'POST /api/v1/urls - Real validator blocked domains' => sub {
     }
 };
 
-subtest 'POST /api/v1/urls - Real validator network errors (422)' => sub {
-    for my $case (
-        {
-            url   => 'http://nonexistent-domain-12345.invalid',
-            error => qr/Cannot reach URL|DNS resolution failed/,
-        },
-        {
-            url   => 'http://192.0.2.1',
-            error => qr/Cannot reach URL|Connection refused/,
-        }
-      )
+subtest 'POST /api/v1/urls - Real validator network errors (async)' => sub {
+    for
+      my $url ( 'http://nonexistent-domain-12345.invalid', 'http://192.0.2.1' )
     {
-        my $res = post_shorten( $case->{url} );
-        if ( $res->{code} == 422 ) {
-            like( $res->{error}, $case->{error},
-                "Network error: $case->{url}" );
-        }
-        else {
-            diag( "Network error test skipped for $case->{url}: "
-                  . $res->{error} );
-        }
-    }
-};
-
-subtest 'POST /api/v1/urls - Real validator SSL certificate validation' => sub {
-    my $res = post_shorten('https://www.example.com');
-    if ( $res->{code} == 200 ) {
-        pass('HTTPS URL with valid SSL certificate accepted');
-    }
-    elsif ( $res->{code} == 422 && $res->{error} =~ /SSL certificate/i ) {
-        diag( "SSL validation: " . $res->{error} );
-    }
-    else {
-        diag( "SSL test skipped: " . $res->{error} );
+        my $res = post_shorten($url);
+        is( $res->{code}, 200, "Network URL accepted asynchronously: $url" );
+        validate_shorten_response( $res, $url, "URL: $url" );
     }
 };
 
@@ -182,17 +156,17 @@ subtest 'POST /api/v1/urls - Real validator invalid URL format' => sub {
         is( $res->{error}, $case->{error}, "Correct error for: $case->{url}" );
     }
 
+};
+
+subtest 'POST /api/v1/urls - Real validator bare hostname' => sub {
     my $res = post_shorten('not-a-url');
-    is( $res->{code}, 422, 'Unreachable host rejected: not-a-url' );
-    like(
-        $res->{error},
-        qr/Cannot reach URL|DNS resolution failed|URL validation failed/,
-        'Correct error for: not-a-url'
-    );
+    is( $res->{code}, 200, 'Bare hostname accepted: not-a-url' );
+    validate_shorten_response( $res, 'http://not-a-url',
+        'Bare hostname normalized' );
 };
 
 subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {
-    my $base         = 'https://www.example.com/';
+    my $base = 'https://www.example.com/';
     my $too_long_url =
       $base . ( 'a' x ( $MAX_URL_LENGTH - length($base) + 1 ) );
     my $res = post_shorten($too_long_url);
@@ -206,22 +180,13 @@ subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {
 
 subtest 'POST /api/v1/urls - Real validator URL edge cases' => sub {
     for my $url (
-        'https://www.example.com?foo=bar',
-        'https://www.example.com#section',
-        'https://www.example.com:443',
-        'https://www.perl.org/about.html',
+        'https://www.example.com?foo=bar', 'https://www.example.com#section',
+        'https://www.example.com:443',     'https://www.perl.org/about.html',
       )
     {
         my $res = post_shorten($url);
-        if ( $res->{code} == 200 ) {
-            ok( validate_short_code_format( $res->{json}->{short_code} ),
-                "Edge case handled: $url" );
-            like( $res->{json}->{original_url},
-                qr/^https?:\/\//, "URL format preserved: $url" );
-        }
-        else {
-            diag( "Edge case test skipped for $url: " . $res->{error} );
-        }
+        is( $res->{code}, 200, "Edge case handled: $url" );
+        validate_shorten_response( $res, $url, "Edge case handled: $url" );
     }
 };
 
@@ -229,65 +194,49 @@ subtest 'POST /api/v1/urls - Real database persistence and retrieval' => sub {
     my $url  = 'https://www.example.com';
     my $res1 = post_shorten($url);
 
-    if ( $res1->{code} == 200 ) {
-        my $code = $res1->{json}->{short_code};
-        ok( validate_short_code_format($code), 'Code generated and stored' );
+    is( $res1->{code}, 200, 'Database write succeeded' );
+    my $code = $res1->{json}->{short_code};
+    ok( validate_short_code_format($code), 'Code generated and stored' );
 
-        my $res2 = get_url($code);
-        if ( $res2->{code} == 200 ) {
-            validate_get_response( $res2, $url, $code, 'Database retrieval' );
-            pass('Database persistence verified');
-        }
-        else {
-            diag( "Database retrieval failed: " . $res2->{error} );
-        }
-    }
-    else {
-        diag( "Database persistence test skipped: " . $res1->{error} );
-    }
+    my $res2 = get_url($code);
+    is( $res2->{code}, 200, 'Database read succeeded' );
+    validate_get_response( $res2, $url, $code, 'Database retrieval' );
+    pass('Database persistence verified');
 };
 
 subtest 'POST /api/v1/urls - Real database duplicate URL handling' => sub {
     my $url  = 'https://www.example.com';
     my $res1 = post_shorten($url);
 
-    if ( $res1->{code} == 200 ) {
-        my $code1 = $res1->{json}->{short_code};
-        ok( validate_short_code_format($code1), 'First code generated' );
+    is( $res1->{code}, 200, 'First create succeeded' );
+    my $code1 = $res1->{json}->{short_code};
+    ok( validate_short_code_format($code1), 'First code generated' );
 
-        my $res2 = post_shorten($url);
-        if ( $res2->{code} == 200 ) {
-            my $code2 = $res2->{json}->{short_code};
-            ok( validate_short_code_format($code2), 'Second code generated' );
-            ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
+    my $res2 = post_shorten($url);
+    is( $res2->{code}, 200, 'Second create succeeded' );
+    my $code2 = $res2->{json}->{short_code};
+    ok( validate_short_code_format($code2), 'Second code generated' );
+    ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
 
-            my $get1 = get_url($code1);
-            my $get2 = get_url($code2);
+    my $get1 = get_url($code1);
+    my $get2 = get_url($code2);
 
-            if ( $get1->{code} == 200 && $get2->{code} == 200 ) {
-                is( $get1->{json}->{original_url},
-                    $url, 'First code retrieves original URL' );
-                is( $get2->{json}->{original_url},
-                    $url, 'Second code retrieves original URL' );
-                pass('Both codes persist and retrieve same URL');
-            }
-        }
-        else {
-            diag( "Duplicate URL test skipped: " . $res2->{error} );
-        }
-    }
-    else {
-        diag( "Duplicate URL test skipped: " . $res1->{error} );
-    }
+    is( $get1->{code}, 200, 'First code retrieves' );
+    is( $get2->{code}, 200, 'Second code retrieves' );
+    is( $get1->{json}->{original_url},
+        $url, 'First code retrieves original URL' );
+    is( $get2->{json}->{original_url},
+        $url, 'Second code retrieves original URL' );
+    pass('Both codes persist and retrieve same URL');
 };
 
 subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
     my $res = get_url('nonexistent123456');
-    is( $res->{code}, 404, 'Non-existent code returns 404' );
+    is( $res->{code}, 400, 'Invalid format rejected: nonexistent123456' );
     is(
         $res->{error},
-        'Short code not found',
-        'Correct error message for non-existent code'
+        'Invalid short code format',
+        'Correct error for: nonexistent123456'
     );
 
     $res = get_url('');
@@ -295,47 +244,11 @@ subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
 
     $res = get_url('invalid@code');
     is( $res->{code}, 400, 'Invalid format rejected: invalid@code' );
-    is( $res->{error}, 'Invalid short code format',
-        'Correct error for: invalid@code' );
-};
-
-subtest 'End-to-end: Full flow with real components' => sub {
-    for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
-        my $res1 = post_shorten($url);
-
-        if ( $res1->{code} == 200 ) {
-            my $code = $res1->{json}->{short_code};
-            ok( validate_short_code_format($code), "Code generated for: $url" );
-
-            my $res2 = get_url($code);
-            if ( $res2->{code} == 200 ) {
-                validate_get_response( $res2, $url, $code, "End-to-end: $url" );
-            }
-            else {
-                diag( "End-to-end GET failed for $url: " . $res2->{error} );
-            }
-        }
-        else {
-            diag( "End-to-end POST failed for $url: " . $res1->{error} );
-        }
-    }
-};
-
-subtest 'Real database connection test' => sub {
-    my $res = post_shorten('https://www.example.com');
-
-    if ( $res->{code} == 200 ) {
-        pass('Database connection successful (Redis accessible)');
-        my $get_res = get_url( $res->{json}->{short_code} );
-        pass('Database read operation successful') if $get_res->{code} == 200;
-    }
-    elsif ( $res->{code} == 400 && $res->{error} =~ /Database error/i ) {
-        diag( "Database connection test: Redis may not be available - "
-              . $res->{error} );
-    }
-    else {
-        diag( "Database connection test skipped: " . $res->{error} );
-    }
+    is(
+        $res->{error},
+        'Invalid short code format',
+        'Correct error for: invalid@code'
+    );
 };
 
 done_testing();