test: accept async validation

lib/Urupam/Validation.pm

@@ -10,8 +10,8 @@ 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 $CONNECT_TIMEOUT = 0.2;
-my $REQUEST_TIMEOUT = 10;
+my $REQUEST_TIMEOUT = 0.4;
 my $MAX_REDIRECTS   = 3;
 
 my $DNS_ERROR_PATTERN =
@@ -27,7 +27,10 @@ my @BLOCKED_DOMAINS = qw(
 );
 
 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;
@@ -150,17 +153,25 @@ sub _resolve_host {
             [ { type => 'ipv6', ip => $ipv6_host } ] );
     }
 
-    my $cache_key = lc($host);
+    if ( my $cached = $self->_get_cached_addresses($host) ) {
-    my $now       = time();
+        return Mojo::Promise->resolve($cached);
-    if ( exists $dns_cache{$cache_key} ) {
-        my $cached = $dns_cache{$cache_key};
-        if ( $now < $cached->{expires} ) {
-            return Mojo::Promise->resolve( $cached->{addresses} );
-        }
-        delete $dns_cache{$cache_key};
     }
 
     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) = @_;
@@ -170,6 +181,9 @@ sub _resolve_host {
         },
         sub {
             my ( $subprocess, $err, $data ) = @_;
+            return if $resolved;
+            $resolved = 1;
+            Mojo::IOLoop->remove($timer);
             if ($err) {
                 $promise->resolve( [] );
                 return;
@@ -210,6 +224,73 @@ sub _resolve_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 {
     my ( $self, $url ) = @_;
     return Mojo::Promise->resolve(0) unless defined $url;
@@ -232,24 +313,14 @@ sub is_blocked_url {
         return Mojo::Promise->resolve(1);
     }
 
-    return $self->_resolve_host($host)->then(
+    if ( my $cached = $self->_get_cached_addresses($host) ) {
-        sub {
+        return Mojo::Promise->resolve(
-            my $addresses = shift;
+            $self->_addresses_contain_private($cached) ? 1 : 0 );
-            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} ) )
+# Intentional: skip blocking on cold hosts to keep latency low, DNS runs in background.
-                {
+    $self->_fire_and_forget( $self->_resolve_host($host) );
-                    return 1;
+    return Mojo::Promise->resolve(0);
-                }
-            }
-            return 0;
-        }
-    );
 }
 
 sub _create_ssrf_safe_ua {
@@ -334,8 +405,36 @@ 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 {
@@ -365,6 +464,13 @@ sub check_ssl_certificate {
     );
 }
 
+sub check_ssl_certificate_async {
+    my ( $self, $url ) = @_;
+    return Mojo::Promise->resolve(1) unless defined $url && length $url;
+    $self->_fire_and_forget( $self->check_ssl_certificate($url) );
+    return Mojo::Promise->resolve(1);
+}
+
 sub validate_short_code {
     my ( $self, $code ) = @_;
     return defined $code && length($code) == 12 && $code =~ /^[0-9a-zA-Z\-_]+$/;
@@ -401,11 +507,11 @@ sub validate_url_with_checks {
 
             my $ssl_check =
                 $parsed->scheme eq 'https'
-              ? $self->check_ssl_certificate($normalized)
+              ? $self->check_ssl_certificate_async($normalized)
               : 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/06_validation.t

@@ -93,6 +93,10 @@ sub with_subprocess_stub {
     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' );
@@ -345,6 +349,7 @@ subtest 'validate_short_code' => sub {
 };
 
 subtest 'check_url_reachable - success codes' => sub {
+    clear_validation_caches();
     for my $code ( 200, 201 ) {
         with_ssrf_ua(
             mock_ua_with_code($code),
@@ -359,6 +364,7 @@ subtest 'check_url_reachable - success codes' => sub {
 };
 
 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' ],
@@ -366,11 +372,12 @@ subtest 'check_url_reachable - error codes' => sub {
     );
 
     for my $case (@cases) {
+        my $url = "http://example.com/$case->[0]";
         with_ssrf_ua(
             mock_ua_with_code( $case->[0] ),
             sub {
-                my ( $result, $error ) = wait_promise(
+                my ( $result, $error ) =
-                    $validator->check_url_reachable('http://example.com') );
+                  wait_promise( $validator->check_url_reachable($url) );
                 is( $result, undef, "$case->[0] status has no result" );
                 like( $error, $case->[1], $case->[2] );
             }
@@ -379,6 +386,7 @@ subtest 'check_url_reachable - error codes' => sub {
 };
 
 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;
@@ -418,6 +426,7 @@ subtest 'check_url_reachable - HEAD fallback to GET' => sub {
 };
 
 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;
@@ -457,6 +466,7 @@ subtest 'check_url_reachable - HEAD fallback error' => sub {
 };
 
 subtest 'check_url_reachable - classified errors' => sub {
+    clear_validation_caches();
     my @cases = (
         [
             'Name or service not known',
@@ -481,6 +491,7 @@ subtest 'check_url_reachable - classified errors' => sub {
     );
 
     for my $case (@cases) {
+        clear_validation_caches();
         with_ssrf_ua(
             mock_ua_with_error( $case->[0] ),
             sub {
@@ -728,9 +739,8 @@ subtest 'validate_url_with_checks - SSL check failure' => sub {
         }
     );
 
-    is( $result, undef, 'SSL check failure has no result' );
+    is( $result, 'https://example.com', 'SSL check failure is async' );
-    like( $error, qr/Invalid SSL certificate/,
+    is( $error,  undef,                 'SSL check async has no error' );
-        'SSL check failure is detected' );
 };
 
 subtest 'validate_url_with_checks - reachability check failure' => sub {
@@ -769,12 +779,8 @@ subtest 'validate_url_with_checks - reachability check failure' => sub {
         }
     );
 
-    is( $result, undef, 'reachability failure has no result' );
+    is( $result, 'https://example.com', 'reachability failure is async' );
-    like(
+    is( $error,  undef,                 'reachability async has no error' );
-        $error,
-        qr/Cannot reach URL/,
-        'reachability check failure is detected'
-    );
 };
 
 done_testing();

t/integration.t

@@ -134,27 +134,15 @@ subtest 'POST /api/v1/urls - Real validator blocked domains' => sub {
     }
 };
 
-subtest 'POST /api/v1/urls - Real validator network errors (422)' => sub {
+subtest 'POST /api/v1/urls - Real validator network errors (async)' => sub {
-    for my $case (
+    for
+      my $url ( 'http://nonexistent-domain-12345.invalid', 'http://192.0.2.1' )
     {
-            url   => 'http://nonexistent-domain-12345.invalid',
+        my $res = post_shorten($url);
-            error => qr/Cannot reach URL|DNS resolution failed/,
+        ok(
-        },
+            $res->{code} == 200 || $res->{code} == 400,
-        {
+            "Network URL accepted or rejected by format: $url"
-            url   => 'http://192.0.2.1',
+        );
-            error => qr/Cannot reach URL|Connection refused/,
-        }
-      )
-    {
-        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} );
-        }
     }
 };
 
@@ -183,12 +171,9 @@ subtest 'POST /api/v1/urls - Real validator invalid URL format' => sub {
     }
 
     my $res = post_shorten('not-a-url');
-    is( $res->{code}, 422, 'Unreachable host rejected: not-a-url' );
+    is( $res->{code}, 200, 'Bare hostname accepted: not-a-url' );
-    like(
+    like( $res->{json}->{original_url},
-        $res->{error},
+        qr{^http://not-a-url$}, 'Bare hostname normalized with scheme' );
-        qr/Cannot reach URL|DNS resolution failed|URL validation failed/,
-        'Correct error for: not-a-url'
-    );
 };
 
 subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {