package Net::SSLLabs;

use strict;
use warnings;
use LWP::UserAgent();
use JSON();
use Net::SSLLabs::Info();
use Net::SSLLabs::Host();
use Net::SSLLabs::Endpoint();
use Net::SSLLabs::StatusCodes();
use Encode();

our $VERSION = '0.02';

sub new {
    my ($class) = @_;
    my $self = {};
    bless $self, $class;
    $self->{url} = 'https://api.ssllabs.com/api/v2/';
    $self->{ua}  = LWP::UserAgent->new();
    $self->{ua}->env_proxy();
    return $self;
}

sub info {
    my ($self)   = @_;
    my $url      = $self->{url} . 'info';
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        return Net::SSLLabs::Info->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub analyze {
    my ( $self, %params ) = @_;
    my $url =
        $self->{url}
      . 'analyze?'
      . (
        join q[&],
        map { _encode($_) . q[=] . _encode( $params{$_} ) } keys %params
      );
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        my $host = Net::SSLLabs::Host->new(
            JSON::decode_json( $response->decoded_content() ) );
        if ( $host->status() eq 'READY' ) {
            return $host;
        }
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
    return;
}

sub getEndpointData {
    my ( $self, %params ) = @_;
    my $url =
        $self->{url}
      . 'getEndpointData?'
      . (
        join q[&],
        map { _encode($_) . q[=] . _encode( $params{$_} ) } keys %params
      );
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        return Net::SSLLabs::Endpoint->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub getStatusCodes {
    my ($self)   = @_;
    my $url      = $self->{url} . 'getStatusCodes';
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        return Net::SSLLabs::StatusCodes->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub _encode {
    my ($decoded) = @_;
    my $encoded = Encode::encode( 'UTF-8', $decoded, 1 );
    $encoded =~
      s/([^[:alnum:]])/join('', map { uc("\%$_") } unpack("H*", $1))/semgx;
    return $encoded;
}

1;    # End of Net::SSLLabs
__END__

=head1 NAME

Net::SSLLabs - An interface to the ssllabs.com service

=head1 VERSION

Version 0.02

=head1 SYNOPSIS

Check the security of your TLS services

    use Net::SSLLabs;

    my $labs = Net::SSLLabs->new();
    ...
    my $host;
    while(not $host = $lab->analyze(host => 'ssllabs.com')) {
        sleep 10;
    }
    foreach my $endpoint ($host->endpoints()) {
        say $host->host() . ' at ' . $endpoint->ipAddress() . ' gets a ' . $endpoint->grade();
    }

=head1 DESCRIPTION

Net::SSLLabs provides a full interface to the API provided by ssllabs.com.

=head1 SUBROUTINES/METHODS

=head2 new

a new I<Net::SSLLabs> object, ready to process TLS services

=head2 info

This call should be used to check the availability of the SSL Labs servers, retrieve the engine and criteria version, and initialize the maximum number of concurrent assessments. Returns one L<Net::SSLLabs::Info|Net::SSLLabs::Info> object on success.

=head2 analyze

This call is used to initiate an assessment, or to retrieve the status of an assessment in progress or in the cache. It will return a single L<Net::SSLLabs::Host|Net::SSLLabs::Host> object on success. The L<Net::SSLLabs::Endpoint|Net::SSLLabs::Endpoint> object embedded in the L<Net::SSLLabs::Host|Net::SSLLabs::Host> object will provide partial endpoint results.

Parameters:

=over 4

=item * host - hostname; required.

=item * publish - set to "on" if assessment results should be published on the public results boards; optional, defaults to "off".

=item * startNew - if set to "on" then cached assessment results are ignored and a new assessment is started. However, if there's already an assessment in progress, its status is delivered instead. This parameter should be used only once to initiate a new assessment; further invocations should omit it to avoid causing an assessment loop.

=item * fromCache - always deliver cached assessment reports if available; optional, defaults to "off". This parameter is intended for when you don't want to wait for assessment results. Can't be used at the same time as the startNew parameter.

=item * maxAge - maximum report age, in hours, if retrieving from cache (fromCache parameter set).

=item * all - by default this call results only summaries of individual endpoints. If this parameter is set to "on", full information will be returned. If set to "done", full information will be returned only if the assessment is complete (status is READY or ERROR).

=item * ignoreMismatch - set to "on" to proceed with assessments even when the server certificate doesn't match the assessment hostname. Set to off by default. Please note that this parameter is ignored if a cached report is returned.

=back 

=head2 getEndpointData

This call is used to retrieve detailed endpoint information. It will return a single L<Net::SSLLabs::Endpoint|Net::SSLLabs::Endpoint> object on success. The object will contain complete assessment information. This call does not initiate new assessments, even when a cached report is not found.

Parameters:

=over 4

=item * host - as above

=item * s - endpoint IP address

=item * fromCache - see above.

=back 

=head2 getStatusCodes

This call will return one L<Net::SSLLabs::StatusCodes|Net::SSLLabs::StatusCodes> instance.

=head1 AUTHOR

David Dick, C<< <ddick at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-ssllabs at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-SSLLabs>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::SSLLabs


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-SSLLabs>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-SSLLabs>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-SSLLabs>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-SSLLabs/>

=back


=head1 ACKNOWLEDGEMENTS

Thanks to Ivan Ristic and the team at qualys.com for providing the service at ssllabs.com

POD was extracted from the API help at L<https://github.com/ssllabs/ssllabs-scan/blob/stable/ssllabs-api-docs.md>

=head1 LICENSE AND COPYRIGHT

Copyright 2015 David Dick.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L<http://dev.perl.org/licenses/> for more information.
