#!/usr/bin/env perl
# Poll the health targets, once, by hand.
#
# WHAT AN OPERATOR WANTS AT 3AM, and what the tests use. The scheduled version
# of this is a Punk::Queue cron task under the leader lease; this is the same
# pass with no scheduler, no lease and no worker around it, so that "is the
# poller broken or is the target broken" is one command rather than an
# inference from an empty chart.
#
#   punk-observe-health --db dbi:SQLite:dbname=var/observe.db --store var/store
#   punk-observe-health --db ... --dry-run          # print, store nothing
#   punk-observe-health --db ... --target shop      # just the one
#
# --dry-run is the answer to the question this is usually run to settle: it
# shows what the poll SAW without writing a history that then has a gap in it
# from the times somebody was debugging.
use 5.010;
use strict;
use warnings;
use Getopt::Long qw(GetOptions);

use Punk::Observe ();
use Punk::Observe::Backend ();
use Punk::Observe::Config ();
use Punk::Observe::Health ();
use Punk::Observe::Store ();

my ($dsn, $store_dir, $tenant, $target, $dry, $allow, $help)
    = (undef, undef, 'default', undef, 0, undef, 0);
GetOptions(
    'db=s'     => \$dsn,
    'store=s'  => \$store_dir,
    'tenant=s' => \$tenant,
    'target=s' => \$target,
    'dry-run'  => \$dry,
    'allow=s'  => \$allow,
    'help'     => \$help,
) or usage(1);
usage(0) if $help;
usage(1, 'a --db dsn is required') unless $dsn;
usage(1, 'a --store directory is required unless --dry-run')
    unless $store_dir || $dry;

sub usage {
    my ($rc, $why) = @_;
    print STDERR "$why\n\n" if $why;
    print STDERR <<'USAGE';
usage: punk-observe-health --db DSN [options]

  --db DSN        the configuration store holding health_targets
  --store DIR     the telemetry store to write the points into
  --tenant NAME   default: default
  --target NAME   poll only this one
  --allow LIST    comma-separated hosts the SSRF policy should admit
  --dry-run       print what was seen; write nothing
USAGE
    exit $rc;
}

my @allow = $allow ? split(/\s*,\s*/, $allow) : ();

my $db = Punk::Observe::Backend->new(dsn => $dsn);
$db->migrate;

my $targets = Punk::Observe::Config::health_targets($db, $tenant, $target);
unless (ref $targets eq 'ARRAY' && @$targets) {
    print "no targets configured", (defined $target ? " named '$target'" : ''),
          "\n";
    exit 0;
}

my $now = Punk::Observe::now_ns();
my @recs;
for my $t (@$targets) {
    unless ($t->{enabled}) {
        printf "%-20s disabled\n", $t->{name};
        next;
    }
    my $r = Punk::Observe::Health::poll($t, allow => (@allow ? \@allow : undef),
                                        now => $now);
    push @recs, @$r;

    # The target-level answer is the one with no `check` label.
    my ($tgt) = grep { !exists $_->{attrs}{check} } @$r;
    my $state = $tgt ? ($tgt->{attrs}{state} || '?') : '?';
    printf "%-20s %-12s %s\n", $t->{name}, $state, $t->{url};

    for my $c (grep { exists $_->{attrs}{check}
                      && $_->{body} eq 'punk.health.ok' } @$r) {
        my ($ms) = map { $_->{value} }
                   grep { $_->{body} eq 'punk.health.ms'
                          && $_->{attrs}{check} eq $c->{attrs}{check} } @$r;
        printf "  %-18s %-12s %s\n", $c->{attrs}{check},
            ($c->{attrs}{skipped} ? 'skipped'
                                  : ($c->{value} ? 'ok' : 'FAILING')),
            (defined $ms ? sprintf('%.2fms', $ms) : '');
    }
}

if ($dry) {
    printf "\n%d point%s, not written (--dry-run)\n",
        scalar @recs, (@recs == 1 ? '' : 's');
    exit 0;
}

my $store = Punk::Observe::Store->new(dir => $store_dir, tenant => $tenant);
require Punk::Observe::WAL;
my $w = Punk::Observe::WAL::append($store->wal_path, \@recs, 1, '200000000');
unless ($w && $w->{ok} && $w->{appended}) {
    print STDERR "the points did not reach the log\n";
    exit 1;
}
$store->seal_if_full($w->{bytes} || 0);
printf "\n%d point%s written\n", scalar @recs, (@recs == 1 ? '' : 's');
exit 0;
