#!/usr/bin/env perl

# Structural coverage checks for the full 19-Part catalogue, per TESTING_automation.md's Phase 3
# acceptance criteria: no raw /tmp path anywhere, every zfs destroy/create/snapshot maps to an
# allow-listed primitive, every rm_matching/list_matching pattern is anchored, a representative
# set of the ~25 real config mutations TESTING.md exercises is actually present, and the known
# optional/record_only/manual steps are dispositioned correctly. This is static analysis of the
# catalogue data itself - it does not execute anything.

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/..";
use lib "$FindBin::Bin/../sneakernet/testing";
use Harness::Catalogue;
use Harness::Safe;
use File::Basename qw(basename);
use JSON::PP qw(decode_json);
use YAMLPatch;

my $passed = 0;
my $failed = 0;

sub ok {
    my ($cond, $desc) = @_;
    if ($cond) { print "  PASS: $desc\n"; $passed++; return 1; }
    else       { print "  FAIL: $desc\n"; $failed++; return 0; }
}

my $catDir = "$FindBin::Bin/../sneakernet/testing/catalogue";
my $cat = Harness::Catalogue->load_dir($catDir);

# ===========================================================================
print "=== no raw /tmp path anywhere - everything routes through {TMP} ===\n";
# ===========================================================================
{
    # Walk the parsed structure rather than grepping raw text, so prose fields (Part 19's
    # manual_note legitimately lists real /tmp/ paths left behind by earlier MANUAL TESTING.md
    # runs, for a human to clean up by hand) don't produce false positives.
    my @offenders;
    use feature 'current_sub';
    my $walk = sub {
        my ($node, $key, $path) = @_;
        return if defined $key && $key eq 'manual_note';
        if (ref($node) eq 'HASH') {
            for my $k (sort keys %$node) { __SUB__->($node->{$k}, $k, "$path.$k") }
        } elsif (ref($node) eq 'ARRAY') {
            my $i = 0;
            for my $v (@$node) { __SUB__->($v, $key, "$path\[" . $i++ . "]") }
        } elsif (!ref($node) && defined($node) && $node =~ m{/tmp/}) {
            push @offenders, $path;
        }
    };
    for my $f (sort glob("$catDir/part*.json")) {
        open my $fh, '<', $f or die "cannot open $f: $!";
        local $/;
        my $data = decode_json(<$fh>);
        close $fh;
        $walk->($data, undef, basename($f));
    }
    ok(!@offenders, "no catalogue field (other than manual_note prose) references a raw /tmp path")
        or print "    offenders: @offenders\n";
}

# ===========================================================================
print "\n=== every zfs_destroy/zfs_create/zfs_snapshot dataset matches a real allow-list ===\n";
# ===========================================================================
{
    my @badDestroy;
    my @badCreate;
    my @badSnapshot;
    my $checked = 0;
    for my $id ($cat->all_step_ids) {
        my $step = $cat->step($id);
        for my $action (@{ $step->{actions} // [] }) {
            my $do = $action->{do} // next;
            my $ds = $action->{dataset} // next;
            next if $ds =~ /\$/;    # runtime-substituted values aren't known statically
            $checked++;
            if ($do eq 'zfs_destroy') {
                push @badDestroy, "$id: $ds" unless grep { $ds =~ $_ } @Harness::Safe::DESTROY_ALLOW;
            } elsif ($do eq 'zfs_create') {
                push @badCreate, "$id: $ds" unless grep { $ds =~ $_ } @Harness::Safe::CREATE_ALLOW;
            } elsif ($do eq 'zfs_snapshot') {
                push @badSnapshot, "$id: $ds" unless grep { $ds =~ $_ } @Harness::Safe::SNAPSHOT_ALLOW;
            }
        }
    }
    ok($checked > 50, "a substantial number of dataset-bearing actions were checked ($checked)");
    ok(!@badDestroy,  "every zfs_destroy dataset matches @Harness::Safe::DESTROY_ALLOW")  or print "    offenders: @badDestroy\n";
    ok(!@badCreate,   "every zfs_create dataset matches @Harness::Safe::CREATE_ALLOW")    or print "    offenders: @badCreate\n";
    ok(!@badSnapshot, "every zfs_snapshot dataset matches @Harness::Safe::SNAPSHOT_ALLOW") or print "    offenders: @badSnapshot\n";
}

# ===========================================================================
print "\n=== no rm_matching/list_matching pattern contains a '/' (Harness::Safe's own refusal) ===\n";
# ===========================================================================
{
    # Harness::Safe::rm_matching/list_matching already refuse a pattern containing '/' at
    # runtime; this is a static double-check that the catalogue never even attempts one - not a
    # requirement that every pattern be a fully ^...$ exact match, since some (Part 8.1's
    # '\.xz$' suffix match, Part 10.4's '.*' match-everything count) are deliberately broader by
    # design.
    my @offenders;
    for my $id ($cat->all_step_ids) {
        my $step = $cat->step($id);
        for my $action (@{ $step->{actions} // [] }) {
            next unless $action->{do} eq 'rm_matching' || $action->{do} eq 'list_matching';
            my $pat = $action->{pattern} // '';
            push @offenders, "$id: $pat" if $pat =~ m{/};
        }
    }
    ok(!@offenders, "no rm_matching/list_matching pattern contains a '/'")
        or print "    offenders: @offenders\n";
}

# ===========================================================================
print "\n=== every 'set' mutation to a YAML-unsafe-bare value gives an explicit style ===\n";
# ===========================================================================
{
    # Regression, found by running --dry-run for real against dd-nas1 (found one bug at a time
    # this way before generalizing): Step 2.3 set transport.mountPoint to '' with no style,
    # defaulting to 'keep' - since the field's live style is bare/unquoted, YAMLPatch correctly
    # refused to emit an empty value unquoted (ambiguous with YAML null). The same class of bug
    # then turned up for '-1' (Step 6.2b, leading '-' is a YAML indicator character) and 'off'
    # (Steps 8.3a/8.6, a YAML 1.1 boolish word). Rather than whack-a-mole individual values, this
    # reuses YAMLPatch's own _looks_safe_bare() - the exact function that decides whether 'keep'
    # can safely stay unquoted - so any future value with the same problem is caught here first,
    # not the first time it actually runs against dd-nas1's real config.
    my @offenders;
    for my $id ($cat->all_step_ids) {
        my $step = $cat->step($id);
        for my $mut (@{ $step->{config}{mutations} // [] }) {
            next unless ($mut->{op} // '') eq 'set';
            next unless defined $mut->{value};
            next if YAMLPatch::_looks_safe_bare($mut->{value});
            push @offenders, "$id: $mut->{path} = '$mut->{value}'" unless $mut->{style};
        }
    }
    ok(!@offenders, "every 'set' mutation whose value isn't YAML-safe-bare specifies an explicit style")
        or print "    offenders: @offenders\n";
}

# ===========================================================================
print "\n=== a representative set of TESTING.md's real config mutations is exercised ===\n";
# ===========================================================================
{
    my %touched;
    for my $id ($cat->all_step_ids) {
        my $step = $cat->step($id);
        for my $mut (@{ $step->{config}{mutations} // [] }) {
            # insert_kv/insert_block address by parent+key rather than a single dotted path.
            my $key = $mut->{path} // (defined($mut->{parent}) && defined($mut->{key}) ? "$mut->{parent}.$mut->{key}" : undef);
            $touched{$key} = 1 if defined $key;
        }
    }
    # Derived by hand-mapping all 23 "Edit `sneakernet.conf.yaml`" instructions in TESTING.md to
    # their target key(s) - several instructions revisit the same key with a different value
    # (fullSendPolicy: allow/warn/skip/abort across Steps 10.1-10.4 is 4 instructions but 1 key),
    # so 18 distinct keys covering 23 instructions is the correct expectation, not a shortfall.
    my @expected = qw(
        target.allowFullOverwrite
        transport.compression.method
        transport.compression.threads
        transport.compression.nice
        source.fullSendPolicy
        source.targetSnapshotList
        datasets.ds1.maxDelta
        datasets.ds2
        datasets.ds3
        datasets.ds4
        target.report.email
        target.report.subject
        target.poolname
        debug
        statusFileBackups
        transport.mountPoint
        transport.verifyFullSendDataset
        transport.verifyStream
    );
    my @missing = grep { !$touched{$_} } @expected;
    ok(!@missing, "every one of TESTING.md's 23 real config-edit instructions maps to a key exercised somewhere in the catalogue (" . scalar(@expected) . " distinct keys)")
        or print "    missing: @missing\n    touched: " . join(', ', sort keys %touched) . "\n";
}

# ===========================================================================
print "\n=== known optional/record_only/manual steps are dispositioned correctly ===\n";
# ===========================================================================
{
    my %expect_class = (
        '4.4' => 'record_only', '8.5' => 'record_only', '13.3' => 'optional',
        '17.1' => 'optional', '17.2' => 'optional', '19.0' => 'manual',
    );
    for my $id (sort keys %expect_class) {
        my $step = $cat->step($id);
        ok(defined($step) && $step->{classification} eq $expect_class{$id},
            "step $id is classified '$expect_class{$id}'")
            or print "    got: " . (defined($step) ? ($step->{classification} // 'assert') : '(step not found)') . "\n";
    }
}

# ===========================================================================
print "\n=== Part 19's teardown is structurally inexpressible, not merely policy-skipped ===\n";
# ===========================================================================
{
    my $died = !eval { Harness::Safe::ds('storage/testing'); 1 };
    ok($died, "the bare sandbox root cannot be constructed as a dataset name at all - no zfs_destroy action anywhere in this harness could ever target it");
}

# ===========================================================================
print "\n=== the full catalogue loads as exactly one connected whole ===\n";
# ===========================================================================
{
    my @parts = sort { $a->{part} <=> $b->{part} } $cat->parts;
    my @partNums = map { $_->{part} } @parts;
    ok(scalar(@partNums) == 20, "all 20 Parts (0 through 19) are present (" . scalar(@partNums) . " found)");
    ok(join(',', @partNums) eq join(',', 0..19), "Part numbers are exactly 0..19 with no gaps or duplicates");
}

print "\n=== Summary ===\n";
print "Passed: $passed\n";
print "Failed: $failed\n";
exit($failed > 0 ? 1 : 0);