path: root/lib/Cepis/Client.pm

package Cepis::Client;

use strict;
use warnings;

use Carp ();
use Encode ();
use HTTP::Tiny;
use JSON::PP ();
use Scalar::Util ();
use Time::HiRes ();

use Cepis::Address;
use Cepis::CSV;
use Cepis::Error;
use Cepis::Health;

our $VERSION = '0.1.0';

use constant DEFAULT_URL => 'https://cep.is';
use constant MAX_BATCH   => 500;

my %RETRIABLE_STATUS = map { $_ => 1 } ( 429, 500, 502, 503, 504 );

my $JSON = JSON::PP->new->utf8;

my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my %MONTH  = map { $MONTHS[$_] => $_ + 1 } 0 .. $#MONTHS;

sub normalize_cep {
    my ($value) = @_;

    if ( !defined $value ) {
        Cepis::Error::InvalidCEP->throw(
            message => 'CEP must be a string, got undef' );
    }
    if ( ref $value ) {
        Cepis::Error::InvalidCEP->throw(
            message => 'CEP must be a string, got a ' . ref($value) . ' reference' );
    }

    my $cleaned = "$value";
    $cleaned =~ s/\A\s+//;
    $cleaned =~ s/\s+\z//;
    $cleaned =~ s/[-. ]//g;

    if ( $cleaned !~ /\A[0-9]{8}\z/ ) {
        Cepis::Error::InvalidCEP->throw(
            message => "CEP must be 8 digits, got '$value'" );
    }

    return $cleaned;
}

sub tls_available {
    return ( 1, undef ) unless HTTP::Tiny->can('can_ssl');
    my ( $ok, $why ) = HTTP::Tiny->can_ssl;
    return ( 1, undef ) if $ok;
    return ( 0, $why );
}

sub new {
    my ( $class, %args ) = @_;

    my $base_url     = _default( $args{base_url},     DEFAULT_URL );
    my $timeout      = _default( $args{timeout},      10.0 );
    my $max_attempts = _default( $args{max_attempts}, 3 );
    my $backoff_base = _default( $args{backoff_base}, 0.5 );
    my $backoff_max  = _default( $args{backoff_max},  8.0 );

    Carp::croak('max_attempts must be >= 1')
        unless Scalar::Util::looks_like_number($max_attempts) && $max_attempts >= 1;
    Carp::croak('timeout must be > 0')
        unless Scalar::Util::looks_like_number($timeout) && $timeout > 0;
    Carp::croak('backoff_base must be >= 0')
        unless Scalar::Util::looks_like_number($backoff_base) && $backoff_base >= 0;
    Carp::croak('backoff_max must be >= 0')
        unless Scalar::Util::looks_like_number($backoff_max) && $backoff_max >= 0;

    $base_url = "$base_url";
    $base_url =~ s{/+\z}{};

    my $user_agent = _default( $args{user_agent},
        "cepis-perl/$VERSION (+https://cep.is)" );

    my $self = {
        base_url      => $base_url,
        timeout       => 0 + $timeout,
        max_attempts  => int( 0 + $max_attempts ),
        backoff_base  => 0 + $backoff_base,
        backoff_max   => 0 + $backoff_max,
        total_timeout => $args{total_timeout},
        user_agent    => "$user_agent",
    };

    $self->{http} = HTTP::Tiny->new(
        agent           => $self->{user_agent},
        timeout         => $self->{timeout},
        default_headers => {
            'Accept'          => 'application/json, text/csv;q=0.9, */*;q=0.1',
            'Accept-Encoding' => 'identity',
        },
    );

    return bless $self, $class;
}

sub base_url      { return $_[0]->{base_url} }
sub timeout       { return $_[0]->{timeout} }
sub max_attempts  { return $_[0]->{max_attempts} }
sub backoff_base  { return $_[0]->{backoff_base} }
sub backoff_max   { return $_[0]->{backoff_max} }
sub total_timeout { return $_[0]->{total_timeout} }
sub user_agent    { return $_[0]->{user_agent} }

sub lookup {
    my ( $self, $cep ) = @_;

    my $number = normalize_cep($cep);
    my ( $status, $body ) = $self->_request("/$number");

    if ( $status == 404 ) {
        Cepis::Error::CEPNotFound->throw(
            message => "CEP $number does not exist in the DNE database" );
    }
    if ( $status == 400 ) {
        Cepis::Error::InvalidCEP->throw(
            message => _error_message( $body, "CEP $number rejected" ) );
    }

    return Cepis::Address->from_json( _json($body) );
}

sub lookup_many {
    my ( $self, $ceps ) = @_;

    Carp::croak('lookup_many expects an array reference of CEPs')
        unless ref $ceps eq 'ARRAY';
    return [] unless @$ceps;

    my @out;
    for ( my $start = 0; $start < @$ceps; $start += MAX_BATCH ) {
        my $end = $start + MAX_BATCH - 1;
        $end = $#$ceps if $end > $#$ceps;
        push @out, @{ $self->_lookup_chunk( [ @{$ceps}[ $start .. $end ] ] ) };
    }

    return \@out;
}

sub health {
    my ($self) = @_;
    my ( undef, $body ) = $self->_request( '/health', accepted_status => [ 200, 503 ] );
    return Cepis::Health->from_json( _json($body) );
}

sub _lookup_chunk {
    my ( $self, $ceps ) = @_;

    my $joined = join ',', map { defined $_ ? "$_" : '' } @$ceps;
    my ( undef, $body ) = $self->_request( '/csv?ceps=' . _escape($joined) );

    my ( $header, $records ) = Cepis::CSV::parse_hashes( _decode($body) );
    unless ( grep { $_ eq 'cep' } @$header ) {
        Cepis::Error::InvalidResponse->throw( message =>
                'response is not the expected CSV — something between you and the '
                . 'API is answering instead of it: ' . _snippet($body) );
    }

    my @out;
    for my $record (@$records) {
        my $localidade = defined $record->{localidade} ? $record->{localidade} : '';
        $localidade =~ s/\A\s+//;
        $localidade =~ s/\s+\z//;
        if ( $localidade eq '' ) {
            push @out, undef;
            next;
        }
        push @out, Cepis::Address->from_json($record);
    }

    push @out, undef while @out < @$ceps;
    splice @out, scalar @$ceps if @out > @$ceps;

    return \@out;
}

sub _request {
    my ( $self, $path, %options ) = @_;

    my @accepted = @{ $options{accepted_status} || [200] };
    my %accepted = map { $_ => 1 } @accepted;

    my $url = $self->{base_url} . $path;
    _assert_tls($url);

    my $deadline
        = defined $self->{total_timeout}
        ? _monotonic() + $self->{total_timeout}
        : undef;

    my $attempts = $self->{max_attempts};
    my ( $last_status, $last_retry_after, $last_network );

    for my $attempt ( 1 .. $attempts ) {
        last if defined $deadline && _monotonic() >= $deadline;

        my $response = $self->{http}->get($url);

        if ( $response->{status} == 599 ) {
            $last_network = $response->{content};
            $last_network = 'unknown transport failure'
                unless defined $last_network && length $last_network;
            $last_network =~ s/\s+\z//;
            $last_status      = undef;
            $last_retry_after = undef;
        }
        else {
            my $status = $response->{status};
            if ( $accepted{$status} || !$RETRIABLE_STATUS{$status} ) {
                return ( $status, $response->{content} );
            }
            $last_status      = $status;
            $last_retry_after = _retry_after_seconds( $response->{headers}{'retry-after'} );
            $last_network     = undef;
        }

        last if $attempt == $attempts;

        my $wait = $self->_backoff( $attempt, $last_retry_after );
        if ( defined $deadline ) {
            my $remaining = $deadline - _monotonic();
            last if $remaining <= 0;
            $wait = $remaining if $wait > $remaining;
        }
        Time::HiRes::sleep($wait) if $wait > 0;
    }

    my $suffix = "(after $attempts attempt(s))";

    if ( defined $last_status && $last_status == 429 ) {
        Cepis::Error::RateLimited->throw(
            message     => "rate limit reached at $url $suffix",
            retry_after => $last_retry_after,
        );
    }
    if ( defined $last_status ) {
        Cepis::Error::ServerError->throw(
            message => "the API answered $last_status at $url $suffix",
            status  => $last_status,
        );
    }
    Cepis::Error::Network->throw(
        message => "could not reach $url $suffix: "
            . ( defined $last_network ? $last_network : 'no attempt was made' ) );
}

sub _assert_tls {
    my ($url) = @_;

    return unless $url =~ m{\Ahttps://}i;

    my ( $ok, $why ) = tls_available();
    return if $ok;

    $why = '' unless defined $why;
    $why =~ s/\s+/ /g;
    $why =~ s/\A\s+//;
    $why =~ s/\s+\z//;

    Cepis::Error::Network->throw( message =>
            "cannot reach $url: HTTP::Tiny has no HTTPS support on this Perl. "
            . 'It needs IO::Socket::SSL 1.968 or later and Net::SSLeay 1.49 or '
            . 'later, and neither of those ships with Perl. Install both '
            . '(cpanm IO::Socket::SSL Net::SSLeay, or your distribution\'s '
            . 'perl-IO-Socket-SSL and perl-Net-SSLeay packages), or point '
            . 'base_url at an http:// instance. HTTP::Tiny reports: '
            . ( length $why ? $why : 'no reason given' ) );
}

sub _backoff {
    my ( $self, $attempt, $retry_after ) = @_;

    if ( defined $retry_after ) {
        return $retry_after < $self->{backoff_max}
            ? $retry_after
            : $self->{backoff_max};
    }

    my $ceiling = $self->{backoff_base} * ( 2**( $attempt - 1 ) );
    $ceiling = $self->{backoff_max} if $ceiling > $self->{backoff_max};
    return rand() * $ceiling;
}

sub _retry_after_seconds {
    my ($value) = @_;

    $value = $value->[0] if ref $value eq 'ARRAY';
    return undef unless defined $value;

    my $text = "$value";
    $text =~ s/\A\s+//;
    $text =~ s/\s+\z//;
    return undef unless length $text;

    if ( $text =~ /\A[0-9]+(?:\.[0-9]+)?\z/ ) {
        return 0 + $text;
    }

    my $epoch = _http_date_epoch($text);
    return undef unless defined $epoch;

    my $seconds = $epoch - time();
    return $seconds > 0 ? $seconds : 0;
}

sub _http_date_epoch {
    my ($text) = @_;

    my ( $day, $month, $year, $hour, $minute, $second );

    if ( $text
        =~ /\A[A-Za-z]+,\s+(\d{1,2})\s+([A-Za-z]{3})\s+(\d{4})\s+(\d{2}):(\d{2}):(\d{2})\s+GMT\z/ )
    {
        ( $day, $month, $year, $hour, $minute, $second ) = ( $1, $2, $3, $4, $5, $6 );
    }
    elsif ( $text
        =~ /\A[A-Za-z]+,\s+(\d{2})-([A-Za-z]{3})-(\d{2})\s+(\d{2}):(\d{2}):(\d{2})\s+GMT\z/ )
    {
        ( $day, $month, $year, $hour, $minute, $second ) = ( $1, $2, $3, $4, $5, $6 );
        $year += $year < 70 ? 2000 : 1900;
    }
    elsif ( $text
        =~ /\A[A-Za-z]+\s+([A-Za-z]{3})\s+([\d ]\d)\s+(\d{2}):(\d{2}):(\d{2})\s+(\d{4})\z/ )
    {
        ( $month, $day, $hour, $minute, $second, $year ) = ( $1, $2, $3, $4, $5, $6 );
        $day =~ s/\s//g;
    }
    else {
        return undef;
    }

    my $number = $MONTH{ ucfirst lc $month };
    return undef unless defined $number;

    return _days_from_civil( $year + 0, $number, $day + 0 ) * 86400
        + $hour * 3600
        + $minute * 60
        + $second;
}

sub _days_from_civil {
    my ( $year, $month, $day ) = @_;

    $year -= 1 if $month <= 2;
    my $era = int( ( $year >= 0 ? $year : $year - 399 ) / 400 );
    my $yoe = $year - $era * 400;
    my $doy = int( ( 153 * ( $month + ( $month > 2 ? -3 : 9 ) ) + 2 ) / 5 ) + $day - 1;
    my $doe = $yoe * 365 + int( $yoe / 4 ) - int( $yoe / 100 ) + $doy;

    return $era * 146097 + $doe - 719468;
}

sub _monotonic {
    if ( defined &Time::HiRes::clock_gettime && defined &Time::HiRes::CLOCK_MONOTONIC ) {
        return Time::HiRes::clock_gettime( Time::HiRes::CLOCK_MONOTONIC() );
    }
    return Time::HiRes::time();
}

sub _json {
    my ($body) = @_;

    my $data = eval { $JSON->decode( defined $body ? $body : '' ) };
    if ( !defined $data ) {
        Cepis::Error::InvalidResponse->throw( message =>
                'response is not valid JSON — something between you and the API '
                . 'is answering instead of it: ' . _snippet($body) );
    }
    if ( ref $data ne 'HASH' ) {
        Cepis::Error::InvalidResponse->throw(
            message => 'expected a JSON object, got ' . ( ref($data) || 'a scalar' ) );
    }

    return $data;
}

sub _error_message {
    my ( $body, $fallback ) = @_;

    my $data = eval { $JSON->decode( defined $body ? $body : '' ) };
    return $fallback unless ref $data eq 'HASH';
    return $fallback unless defined $data->{mensagem} && !ref $data->{mensagem};
    return "$data->{mensagem}";
}

sub _decode {
    my ($body) = @_;
    return '' unless defined $body;
    my $text = Encode::decode( 'UTF-8', $body, Encode::FB_DEFAULT() );
    $text =~ s/\A\x{FEFF}//;
    return $text;
}

sub _snippet {
    my ($body) = @_;
    my $text = defined $body ? substr( $body, 0, 120 ) : '';
    $text =~ s/([^\x20-\x7E])/sprintf('\\x%02X', ord $1)/ge;
    return "'$text'";
}

sub _escape {
    my ($value) = @_;
    my $bytes = Encode::encode( 'UTF-8', "$value" );
    $bytes =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord $1)/ge;
    return $bytes;
}

sub _default {
    my ( $value, $fallback ) = @_;
    return defined $value ? $value : $fallback;
}

1;

__END__

=encoding UTF-8

=head1 NAME

Cepis::Client - configurable client for the cep.is API

=head1 SYNOPSIS

    use Cepis::Client;

    my $client = Cepis::Client->new(
        base_url      => 'https://cep.is',
        timeout       => 10.0,
        max_attempts  => 3,
        backoff_base  => 0.5,
        backoff_max   => 8.0,
        total_timeout => 15.0,
    );

    my $address = $client->lookup('01001-000');
    my $result  = $client->lookup_many( [ '01001000', '99999999' ] );
    my $health  = $client->health;

=head1 DESCRIPTION

Build one instance and reuse it. The configuration is fixed at construction and
no method keeps state between calls, so a single client can serve a whole
process. It holds one L<HTTP::Tiny> internally, which keeps the connection alive
between calls; that object is not shared between threads, so give each thread its
own client.

Retries cover 429, 500, 502, 503, 504 and network failures, with exponential
backoff and full jitter. 400 and 404 are never retried: both are definitive
answers about the request, so retrying returns the same thing more slowly while
burning someone's quota.

=head2 HTTPS support

L<HTTP::Tiny> is a core module and speaks plain HTTP out of the box, but it
speaks B<HTTPS only when L<IO::Socket::SSL> 1.968 or later and L<Net::SSLeay>
1.49 or later are installed>, and neither of those ships with Perl. This library
therefore has no non-core dependencies, but the default C<base_url> of
C<https://cep.is> needs those two modules present.

When they are missing, a request to an C<https:> URL throws
L<Cepis::Error::Network> immediately, before any attempt is made, with a message
naming both modules. No amount of retrying fixes a missing module, so it does
not retry.

L</tls_available> reports the same thing without making a request.

=head1 FUNCTIONS

=head2 normalize_cep

    my $number = Cepis::Client::normalize_cep('01001-000');    # "01001000"

Returns the CEP's 8 digits, accepting the mask. C<"01001-000">, C<"01001000">,
C<" 01001-000 "> and C<"01001.000"> all become C<"01001000">.

Throws L<Cepis::Error::InvalidCEP> unless exactly 8 digits remain. This runs
B<before> any request: a 7-digit CEP is the caller's bug, and spending a round
trip for the server to say so wastes both sides' time.

Note that Perl does not distinguish a number from a string, so passing the
literal C<01001000> passes a 7-digit number — the leading zero is gone before
this function ever sees it. Keep CEPs in strings.

Also reachable as C<Cepis::normalize_cep>.

=head2 tls_available

    my ( $ok, $why ) = Cepis::Client::tls_available();

Reports whether L<HTTP::Tiny> on this Perl can do HTTPS. Returns a true value
and C<undef> when it can; false and the reason when it cannot. See
L</"HTTPS support">.

=head1 CONSTRUCTOR

=head2 new

    my $client = Cepis::Client->new(%options);

All options have defaults, so C<< Cepis::Client->new >> is valid. C<croak>s on a
value that cannot work, which is a programming error rather than a
L<Cepis::Error>.

=over 4

=item base_url

Where the API lives. Defaults to C<https://cep.is>. Point it at a local instance
(the API repo brings one up on C<http://localhost:8080> with C<just up>) or at a
test server. It is the only option that usually changes between environments.
Trailing slashes are stripped, so it cannot produce doubled separators that some
proxies normalise and others 404.

=item timeout

Seconds to wait B<per socket operation> — L<HTTP::Tiny> applies it to the
connect and to each read, so it is not a cap on the whole call. That cap is
L</total_timeout>. Defaults to 10.

=item max_attempts

How many attempts in total, counting the first. C<1> disables retrying. The
default of C<3> covers the common case (one transient failure) without turning a
real outage into a long wait.

=item backoff_base

Base of the exponential wait, in seconds; defaults to 0.5. The actual wait is
drawn from C<[0, base * 2**(n-1)]> — I<full jitter>. The randomness is not
decoration: without it, N clients that fail together come back together and
reproduce the spike that took the service down.

=item backoff_max

Cap on each individual wait, in seconds; defaults to 8. It applies to a
server-sent C<Retry-After> too, or a C<Retry-After: 3600> from a misconfigured
proxy would park the process for an hour.

=item total_timeout

Cap on the whole call, attempts and waits included. C<undef> (the default)
leaves L</max_attempts> as the only bound. Set it in code serving a web request:
without it the worst case is C<max_attempts * timeout> plus the sum of the
backoffs.

=item user_agent

Overrides the C<User-Agent>. The default identifies the library and its version,
which is what lets the server diagnose an old client misbehaving.

=back

=head1 METHODS

=head2 lookup

    my $address = $client->lookup('01001-000');

Looks up a single CEP and returns a L<Cepis::Address>. Accepts the CEP masked or
unmasked.

A 400 from the API is surfaced as L<Cepis::Error::InvalidCEP> carrying the API's
own message: the format already passed local validation, so the server knows
something this client does not.

Throws L<Cepis::Error::InvalidCEP> when the CEP is not 8 digits (no request is
made), L<Cepis::Error::CEPNotFound> when it is well-formed but absent from the
database, L<Cepis::Error::RateLimited> on 429 after every attempt,
L<Cepis::Error::ServerError> on 5xx after every attempt,
L<Cepis::Error::Network> when the request never completed, and
L<Cepis::Error::InvalidResponse> when a success status carries an unreadable
body.

=head2 lookup_many

    my $result = $client->lookup_many( \@ceps );

Looks up many CEPs in one request each 500 and returns an B<arrayref of the same
length and in the same order as the input>. A CEP that does not exist is
C<undef> at its position — it does not vanish from the list, and it does not
throw. That is the right difference from L</lookup>: in a batch of a thousand,
one bad CEP must not cost the other nine hundred and ninety-nine.

A malformed CEP is also C<undef>, for the same reason, rather than throwing. To
know I<which> one was malformed, validate first with L</normalize_cep>.

The result is an arrayref rather than a list precisely because it may contain
C<undef>. A Perl array holds C<undef> at any position without shortening — no
element is lost and nothing shifts — so C<< $result->[$i] >> always corresponds
to C<< $ceps[$i] >>. Reading the result with C<grep { defined }> discards the
misses; reading it with C<for my $i ( 0 .. $#$result )> keeps the pairing.

Input longer than 500 is chunked automatically. Do not loop over L</lookup>: a
loop of 500 calls pays 500 TLS handshakes, the batch pays one.

B<The batch carries no coordinate.> The endpoint behind it is CSV, and the CSV
has no C<geo> column. Every L<Cepis::Address> returned here has C<geo> set to
C<undef>, including for CEPs that do have one. Need C<geo>? Use L</lookup>, one
at a time.

The API guarantees one row per requested CEP. Should that ever fail to hold — a
proxy truncating, a cut response — the result is padded with C<undef> to the
input length rather than returned short, because a shifted list silently pairs
the wrong address with the wrong CEP.

=head2 health

    my $health = $client->health;

Queries C<GET /health> and returns a L<Cepis::Health>: does the API answer, and
with which database.

Does not throw for an API reporting itself degraded — that arrives in
C<< $health->status >>, and checking health is exactly when you want the
diagnosis rather than an exception. Network failures still throw.

=head1 ACCESSORS

C<base_url>, C<timeout>, C<max_attempts>, C<backoff_base>, C<backoff_max>,
C<total_timeout> and C<user_agent> each return the configured value.

=head1 CONSTANTS

=head2 DEFAULT_URL

C<https://cep.is>.

=head2 MAX_BATCH

C<500>, the most CEPs the API accepts in a single batch request.

=head1 SEE ALSO

L<Cepis>, L<Cepis::Address>, L<Cepis::Health>, L<Cepis::Error>

=head1 LICENCE

ISC. Copyright (c) 2026 Murilo Ijanc E<lt>[email protected]<gt>.

=cut