Initial importv0.1.0

1 files changed, 652 insertions, 0 deletions

diff --git a/lib/Cepis/Client.pm b/lib/Cepis/Client.pm
new file mode 100644
index 0000000..35eb51b
--- /dev/null
+++ b/lib/Cepis/Client.pm
@@ -0,0 +1,652 @@
+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