package OpenTelemetry::Instrumentation::HTTP::Tiny;
# ABSTRACT: OpenTelemetry instrumentation for HTTP::Tiny

our $VERSION = '0.032';

use strict;
use warnings;
use experimental 'signatures';

use Class::Inspector;
use Class::Method::Modifiers 'install_modifier';
use Feature::Compat::Defer;
use List::Util 'any';
use OpenTelemetry::Constants qw( SPAN_KIND_CLIENT SPAN_STATUS_ERROR );
use OpenTelemetry::Context;
use OpenTelemetry::Trace;
use OpenTelemetry;
use Ref::Util qw( is_arrayref is_coderef );
use Syntax::Keyword::Dynamically;
use isa 'URI::http';

use parent 'OpenTelemetry::Instrumentation';

sub dependencies { 'HTTP::Tiny' }

my sub get_headers ( $have, $want, $prefix ) {
    return unless @$want;

    map {
        my ( $k, $v ) = ( $_->[0], $have->{ $_->[1] } );
        "$prefix.$k" => is_arrayref $v ? $v : [ $v ]
    }
    grep { my $k = $_->[0]; any { $k =~ $_ } @$want }
    map { [ lc tr/-/_/r, $_ ] }
    keys %$have;
}

my ( $original, $loaded );

sub uninstall ( $class ) {
    return unless $original;
    no strict 'refs';
    no warnings 'redefine';
    delete $Class::Method::Modifiers::MODIFIER_CACHE{'HTTP::Tiny'}{request};
    *{'HTTP::Tiny::request'} = $original;
    undef $loaded;
    return;
}

sub install ( $class, %config ) {
    return if $loaded;
    return unless Class::Inspector->loaded('HTTP::Tiny');

    require URI;

    my @wanted_request_headers = map qr/^\Q$_\E$/i, map tr/-/_/r,
        @{ delete $config{request_headers}  // [] };

    my @wanted_response_headers = map qr/^\Q$_\E$/i, map tr/-/_/r,
        @{ delete $config{response_headers} // [] };

    $original = \&HTTP::Tiny::request;
    install_modifier 'HTTP::Tiny' => around => request => sub {
        my ( $code, $self, $method, $url, $options ) = @_;

        my $uri = URI->new("$url");

        my %url_data;
        if ( isa_URI_http $uri ) {
            $uri->userinfo('REDACTED:REDACTED') if $uri->userinfo;
            %url_data = (
                'server.address' => $uri->host,
                'server.port'    => $uri->port,
            );
        }

        my $span = OpenTelemetry->tracer_provider->tracer(
            name    => __PACKAGE__,
            version => $VERSION,
        )->create_span(
            name       => $method,
            kind       => SPAN_KIND_CLIENT,
            attributes => {
                %url_data,
                # As per https://github.com/open-telemetry/semantic-conventions/blob/main/docs/http/http-spans.md
                'http.request.method'      => $method,
                'network.protocol.name'    => 'http',
                'network.protocol.version' => '1.1',
                'network.transport'        => 'tcp',
                'url.full'                 => "$uri", # redacted
                'user_agent.original'      => $self->agent,

                # This does not include auto-generated headers
                # Capturing those would require to hook into the
                # handle's write_request method
                get_headers(
                    $self->{default_headers}, # Apologies to the encapsulation gods
                    \@wanted_request_headers,
                    'http.request.header'
                ),

                get_headers(
                    $options->{headers},
                    \@wanted_request_headers,
                    'http.request.header'
                ),

                # Request body can be generated by setting content to a
                # code reference, in which case we don't set this attribute
                # Setting it would likely involve us hooking into the
                # handle's write_body method
                defined $options->{content} && ! is_coderef $options->{content}
                    ? ( 'http.request.body.size' => length $options->{content} )
                    : (),
            },
        );

        dynamically OpenTelemetry::Context->current
            = OpenTelemetry::Trace->context_with_span($span);

        OpenTelemetry->propagator->inject( \my %carrier );
        $options->{headers} = { %{ $options->{headers} // {} }, %carrier }
            if %carrier;

        defer { $span->end }

        my $res = $self->$code( $method, $url, $options );
        $span->set_attribute( 'http.response.status_code' => $res->{status} );

        # TODO: this should include retries
        $span->set_attribute( 'http.resend_count' => scalar @{ $res->{redirects} } )
            if $res->{redirects};

        my $length = $res->{headers}{'content-length'};
        $span->set_attribute( 'http.response.body.size' => $length )
            if defined $length;

        unless ( $res->{success} ) {
            my $description;
            if ( $res->{status} == 599 ) {
                my $error = ( $res->{content} // '' ) =~ s/^\s+|\s+$//r;
                ($description) = split /\n/, $error, 2;
                $description =~ s/ at \S+ line \d+\.$//a;

            }
            else {
                $description = $res->{status};
            }

            $span->set_status( SPAN_STATUS_ERROR, $description );
        }

        $span->set_attribute(
            get_headers(
                $res->{headers},
                \@wanted_response_headers,
                'http.response.header'
            )
        );

        return $res;
    };

    return $loaded = 1;
}

1;
