File Coverage

blib/lib/Net/ACME2/Error.pm

Criterion	Covered	Total	%
statement	21	43	48.8
branch	0	6	0.0
condition	0	5	0.0
subroutine	7	11	63.6
pod	0	4	0.0
total	28	69	40.5

package Net::ACME2::Error;

=encoding utf-8

=head1 NAME

Net::ACME2::Error - error parsing logic for ACME

=head1 SYNOPSIS

    use Net::ACME2::Error;

    my $err = Net::ACME2::Error->new( { type => '..', .. } );

=head1 DESCRIPTION

This simple module interfaces with ACME2 “error” objects,
which are described in the ACME protocol specification.

=head1 NOTES

ACME’s errors are basically just HTTP API problem detail documents,
which are described in more detail at L.

=cut

use strict;
use warnings;

use parent qw( Net::ACME2::AccessorBase );

my $URN_PREFIX = 'urn:ietf:params:acme:error:';

use constant _ACCESSORS => qw(
    detail
    instance
    status
    title
    type
);

#cf. https://ietf-wg-acme.github.io/acme/#errors
use constant _TYPE_DESCRIPTION => {
    badCSR                => 'The CSR is unacceptable (e.g., due to a short key)',
    badNonce              => 'The client sent an unacceptable anti-replay nonce',
    badSignatureAlgorithm => 'The JWS was signed with an algorithm the server does not support',
    invalidContact        => 'A contact URL for an account was invalid',
    unsupportedContact        => 'A contact URL for an account used an unsupported protocol scheme',
    accountDoesNotExist   => 'The request specified an account that does not exist',
    malformed             => 'The request message was malformed',
    rateLimited           => 'The request exceeds a rate limit',
    rejectedIdentifier    => 'The server will not issue for the identifier',
    serverInternal        => 'The server experienced an internal error',
    unauthorized          => 'The client lacks sufficient authorization',
    unsupportedIdentifier => 'Identifier is not supported, but may be in the future',
    userActionRequired => 'Visit the “instance” URL and take actions specified there',
    badRevocationReason => 'The revocation reason provided is not allowed by the server',
    dns => 'There was a problem with a DNS query',

    connection            => 'The server could not connect to a validation target',
    dnssec                => 'The server could not validate a DNSSEC signed domain',
    caa                   => 'CAA records forbid the CA from issuing',
    tls                   => 'The server received a TLS error during validation',
    incorrectResponse     => 'Response received didn’t match the challenge’s requirements',
};

sub type {
    my ($self) = @_;

    return $self->SUPER::type() || 'about:blank';
}

sub description {
    my ($self) = @_;

    my $type = $self->type();

    $type =~ s<\A$URN_PREFIX><>;

    return _TYPE_DESCRIPTION()->{$type};
}

sub subproblems {
    my ($self) = @_;

    Call::Context::must_be_list();

    my $subs_ar = $self->{'_subproblems'} or return;

    return map { Net::ACME2::Error::Subproblem->new($_) } @$subs_ar;
}

sub to_string {
    my ($self) = @_;

    my $str = $self->status() . ' ' . $self->type();

    for my $attribute ( qw( title description detail instance ) ) {
        my $value = $self->$attribute();
        if ( defined $value && length $value ) {
            $str .= " ($value)";
        }
    }

    my @subs = $self->subproblems();
    if (@subs) {
        $str .= ' (' . join(', ', map { $_->to_string() } @subs) . ')';
    }

    return $str;
}

#----------------------------------------------------------------------

package Net::ACME2::Error::Subproblem;

use parent qw( Net::ACME2::Error );

use constant _ACCESSORS => (
    __PACKAGE__->SUPER::_ACCESSORS(),
    'identifier',
);

1;