view release on metacpan or  search on metacpan

t/155-restore-atomic.t  view on Meta::CPAN

use Path::Tiny qw( path );
use Try::Tiny;

use App::karr::Encoding qw( yaml_dump yaml_load );
use App::karr::Git;

# Ticket #155: `karr restore` (replace_board_refs) validates every ref and
# builds every commit in phase one, then writes the refs in place in phase
# two. Before the fix, a ref write that failed in phase two (a lock
# contention exhaustion that survived retry_contended, a real libgit2 error,
# anything that produced a die out of _write_ref_oid) left the board with
# the first N-1 snapshot refs and the last one still pointing at its
# pre-restore content -- the catastrophic half-apply the test below
# reproduces. The fix snapshots the original refs/karr/* state before phase
# two and restores it on any failure, so the board ends up exactly as it
# was before the failed restore rather than as a mixture.

sub _git_ok {
    my (@cmd) = @_;
    my $rc = system(@cmd);
    is( $rc, 0, "@cmd" );
}

# In-process runner (t/lib/TestKarr.pm): same ($cwd, @argv) signature and
# { exit, stdout, stderr } return as the open3 helper this file used to carry,
# dispatched through the shared App::karr::Dispatch path. KARR_TEST_SUBPROC=1
# restores the old open3 path.
sub _run_karr { return run_karr(@_) }

sub _refs {
    my (@cmd) = @_;
    open my $fh, '-|', @cmd or die "cannot run @cmd: $!";
    my @refs = <$fh>;
    close $fh;
    chomp @refs;
    return sort @refs;
}

sub _local_karr_refs {
    my ($work) = @_;
    return _refs( 'git', '-C', $work, 'for-each-ref', '--format=%(refname)', 'refs/karr/' );
}

sub _board {
    my $root = tempdir( CLEANUP => 1 );
    my $work = "$root/work";

    _git_ok( 'git', 'init', '-q', $work );
    _git_ok( 'git', '-C', $work, 'config', 'user.email', 'test@example.com' );
    _git_ok( 'git', '-C', $work, 'config', 'user.name',  'Test User' );

    is( _run_karr( $work, 'init', '--name', 'Atomic Board' )->{exit}, 0, 'board initialized' );
    is( _run_karr( $work, 'create', "task $_" )->{exit}, 0, "task $_ created" ) for 1 .. 3;

    return ( $root, $work );
}

sub _snapshot_of {
    my ( $work, $root ) = @_;
    my $file = "$root/good.yml";
    is( _run_karr( $work, 'backup', '--output', $file )->{exit}, 0, 'backup written' );
    return ( $file, yaml_load( path($file)->slurp_utf8 ) );
}

subtest 'a write failure in phase two leaves the board untouched' => sub {
    my ( $root, $work ) = _board();
    my ( $file, $snapshot ) = _snapshot_of( $work, $root );

    # Mutate the snapshot so its contents differ from the live board on
    # EVERY ref. Without this change a "the refs read back the same"
    # assertion would still pass on the pre-fix code, because the snapshot
    # and the live board would be identical and the half-applied state
    # would be indistinguishable from the original state. The phase-two
    # write order is sorted, so the very first ref to land is
    # refs/karr/config -- the snapshot's config has a different `name`,
    # so the half-applied state would leave the live board with the
    # snapshot's config and the live board's tasks, which is the bug.
    $snapshot->{refs}{'refs/karr/config'} =~ s/name: \K.*/From Snapshot/m;
    for my $id ( 1 .. 3 ) {
        my $key = "refs/karr/tasks/$id/data";
        my $fm  = $snapshot->{refs}{$key};
        $fm =~ s/^title: .*$/title: "snapshot-of-task-$id"/m;
        $snapshot->{refs}{$key} = $fm;
    }
    my $mutated = "$root/mutated.yml";
    path($mutated)->spew_utf8( yaml_dump($snapshot) );

    my @before = _local_karr_refs($work);
    ok( scalar @before, 'the board has refs before the restore' );

    # Snapshot the content of every board ref so the test can compare
    # contents, not just ref names. The ref-set is the same before and
    # after a half-applied phase two; the bug is in what each ref points
    # at, which is exactly what a "compare the names" assertion misses.
    my $git = App::karr::Git->new( dir => $work );
    my %before_content = map { $_ => $git->read_ref($_) } sort keys %{ $snapshot->{refs} };

    # Phase two writes the refs in sorted order. Inject a failure on the
    # second write so ref 1 lands at the snapshot value, ref 2 fails, and
    # everything past it stays at the pre-restore value. The pre-fix
    # `replace_board_refs` returned 1 because the die happened after some
    # writes had already landed, so the half-applied state was the success
    # path, not the error path.
    my $fail_at = 2;
    my $calls   = 0;
    no warnings 'redefine';
    local *App::karr::Git::_write_ref_oid = sub {
        my ( $self, $ref, $oid ) = @_;
        $calls++;
        die "karr: could not write $ref: injected failure for ticket #155\n"
            if $calls == $fail_at;
        return $self->retry_contended( "ref $ref", sub {
            my $repo = $self->_repo;
            $repo->reference_create( $ref, $oid, force => 1 );
            $App::karr::Git::WRITES++;
            1;
        } );
    };

    my $err = try {
        $git->replace_board_refs( $snapshot->{refs} );