#! /usr/bin/env perl

# Simplified BSD License (FreeBSD License)
#
# Copyright (c) 2026, Daily Data Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# Harness::Catalogue - loads and validates the JSON step catalogue (the 19 Parts of
# TESTING.md, expressed as data). See TESTING_automation.md section 8.
#
# Deliberately JSON, not YAML: the only YAML parser available on the target host
# (YAML::Tiny) is exactly the thing this whole project distrusts (see YAMLPatch.md's
# rationale) - writing the harness's own control data in that format would risk a harness
# that misparses its own step definitions. JSON::PP is core and unambiguous.
#
# Symbolic tokens (TESTING_automation.md section 8) are expanded in exactly one place here,
# recursively, over every string value in the loaded structure - so a path can never be typed
# two different ways in two different steps and drift apart.

package Harness::Catalogue;

use strict;
use warnings;
use Carp qw(croak);
use JSON::PP qw(decode_json);
use File::Basename qw(dirname);

our %TOKENS = (
    '{CODE}'      => '/storage/testing/code',
    '{SN}'        => '/storage/testing/code/sneakernet',
    '{CONFIG}'    => '/storage/testing/code/sneakernet/sneakernet.conf.yaml',
    '{TRANSPORT}' => '/storage/testing/transport',
    '{REPORT}'    => '/storage/testing/report',
    '{ONESHOT}'   => '/storage/testing/oneshot',
    '{TMP}'       => '/storage/testing/tmp',
    '{HARNESS}'   => '/storage/testing/harness',
    '{VERIFY}'    => 'storage/testing/verify',
    '{SRC}'       => 'storage/testing/src',
    '{DST}'       => 'storage/testing/dst',
);

# Top-level keys allowed on a Part; per-step keys allowed on a Step. An unknown key anywhere
# is a fatal load-time error, not a warning - a typo in the catalogue should never silently
# become a no-op step.
my %PART_KEYS = map { $_ => 1 } qw(part title reset steps _comment);
my %STEP_KEYS = map { $_ => 1 }
    qw(id title classification depends_on exports imports config actions assertions cleanup manual_note _comment);
my %CONFIG_KEYS = map { $_ => 1 } qw(preconditions mutations restore expects_invalid_config);
my %VALID_CLASS = map { $_ => 1 } qw(assert record_only optional manual);
my %VALID_RESTORE = map { $_ => 1 } qw(auto none always);

sub _expand_tokens {
    my ($val) = @_;
    if (ref($val) eq 'HASH') {
        return { map { $_ => _expand_tokens($val->{$_}) } keys %$val };
    }
    if (ref($val) eq 'ARRAY') {
        return [ map { _expand_tokens($_) } @$val ];
    }
    if (!ref($val) && defined($val) && !JSON::PP::is_bool($val)) {
        for my $tok (keys %TOKENS) {
            $val =~ s/\Q$tok\E/$TOKENS{$tok}/g if $val =~ /\Q$tok\E/;
        }
    }
    return $val;
}

sub _validate_keys {
    my ($hash, $allowed, $where) = @_;
    for my $k (keys %$hash) {
        croak "Harness::Catalogue: unknown key '$k' in $where" unless $allowed->{$k};
    }
}

sub _slurp_json {
    my ($path) = @_;
    open my $fh, '<', $path or croak "Harness::Catalogue: cannot read '$path': $!";
    local $/;
    my $text = <$fh>;
    close $fh;
    my $data = eval { decode_json($text) };
    croak "Harness::Catalogue: '$path' is not valid JSON: $@" if $@;
    return $data;
}

# load_dir($dir) -> Harness::Catalogue object
#
# Loads every catalogue/partNN.json file plus reset_profiles.json from $dir, validates
# structure, expands tokens, and builds the dependency-aware step index.
sub load_dir {
    my ($class, $dir) = @_;
    my $self = bless { parts => [], steps => {}, order => [], reset_profiles => {} }, $class;

    my $rpFile = "$dir/reset_profiles.json";
    if (-e $rpFile) {
        my $rp = _slurp_json($rpFile);
        $self->{reset_profiles} = _expand_tokens($rp);
    }

    opendir(my $dh, $dir) or croak "Harness::Catalogue: cannot opendir '$dir': $!";
    my @files = sort grep { /^part\d+\.json$/ } readdir($dh);
    closedir $dh;
    croak "Harness::Catalogue: no part*.json files found in '$dir'" unless @files;

    for my $file (@files) {
        my $raw = _slurp_json("$dir/$file");
        _validate_keys($raw, \%PART_KEYS, "part file '$file'");
        croak "Harness::Catalogue: '$file': missing 'part'" unless defined $raw->{part};
        croak "Harness::Catalogue: '$file': missing 'steps' array" unless ref($raw->{steps}) eq 'ARRAY';

        my $part = _expand_tokens($raw);
        push @{ $self->{parts} }, $part;

        for my $step (@{ $part->{steps} }) {
            _validate_keys($step, \%STEP_KEYS, "step in part $part->{part} ('$file')");
            croak "Harness::Catalogue: step in '$file' missing 'id'" unless defined $step->{id};
            croak "Harness::Catalogue: duplicate step id '$step->{id}'" if exists $self->{steps}{$step->{id}};

            $step->{classification} //= 'assert';
            croak "Harness::Catalogue: step '$step->{id}' has unknown classification '$step->{classification}'"
                unless $VALID_CLASS{$step->{classification}};

            $step->{depends_on} //= [];
            $step->{exports}    //= [];
            $step->{imports}    //= [];
            $step->{actions}    //= [];
            $step->{assertions} //= [];
            $step->{cleanup}    //= [];

            if ($step->{config}) {
                _validate_keys($step->{config}, \%CONFIG_KEYS, "step '$step->{id}' config block");
                $step->{config}{preconditions} //= [];
                $step->{config}{mutations}     //= [];
                $step->{config}{restore}       //= 'auto';
                croak "Harness::Catalogue: step '$step->{id}' has unknown config.restore '$step->{config}{restore}'"
                    unless $VALID_RESTORE{$step->{config}{restore}};
            } else {
                $step->{config} = { preconditions => [], mutations => [], restore => 'auto', expects_invalid_config => 0 };
            }

            $step->{part} = $part->{part};
            $step->{reset} //= $part->{reset} // 'standard';
            $self->{steps}{$step->{id}} = $step;
            push @{ $self->{order} }, $step->{id};
        }
    }

    $self->_validate_dependencies;
    return $self;
}

sub _validate_dependencies {
    my ($self) = @_;
    for my $id (@{ $self->{order} }) {
        my $step = $self->{steps}{$id};
        for my $dep (@{ $step->{depends_on} }) {
            croak "Harness::Catalogue: step '$id' depends_on unknown step '$dep'"
                unless exists $self->{steps}{$dep};
        }
    }
}

sub parts { return @{ $_[0]->{parts} } }
sub all_step_ids { return @{ $_[0]->{order} } }
sub step { my ($self, $id) = @_; return $self->{steps}{$id}; }
sub reset_profile { my ($self, $name) = @_; return $self->{reset_profiles}{$name}; }

sub steps_in_part {
    my ($self, $partNum) = @_;
    return grep { $_->{part} == $partNum } map { $self->{steps}{$_} } @{ $self->{order} };
}

# Given a requested list of step ids, returns the same list (in catalogue order) plus every
# transitively-required dependency, UNLESS $forcePartial is true, in which case it returns
# exactly what was asked for and lets the caller find out the hard way (matching
# TESTING_automation.md 6.8: "the runner refuses a selection that omits a declared dependency
# unless --force-partial is given").
sub resolve_selection {
    my ($self, $requestedIds, $forcePartial) = @_;
    my %want = map { $_ => 1 } @$requestedIds;
    unless ($forcePartial) {
        my @queue = @$requestedIds;
        while (@queue) {
            my $id = shift @queue;
            my $step = $self->step($id) or croak "Harness::Catalogue: unknown step id '$id'";
            for my $dep (@{ $step->{depends_on} }) {
                next if $want{$dep};
                $want{$dep} = 1;
                push @queue, $dep;
            }
        }
    }
    return grep { $want{$_} } @{ $self->{order} };
}

1;

__END__
See sneakernet/Documentation/TESTING_automation.md section 8 for the schema this module
enforces, and section 3.1 for why symbolic tokens exist at all (Steps 9.2/11.1's
source.targetSnapshotList path must be identical whether read as a shell path or a YAML
value - a single token expanded in one place is what guarantees that).