use v6.d;

# Generated by App::Ariza. This file is deliberately core-only: it ships in
# the application's private bundle and must not depend on the build tool.

class Ariza::Update::Coordinator {
    constant CADENCE = 604800;
    constant MAX-STATE-BYTES = 4096;
    constant HANDOFF-ENV = 'ARIZA_UPDATE_HANDOFF';
    constant NONCE-ENV = 'ARIZA_UPDATE_NONCE';
    constant RELAUNCHED-ENV = 'ARIZA_UPDATE_RELAUNCHED';

    has Str $.app-name      = {{ app_name_q }};
    has Str $.app-exec      = {{ app_exec_q }};
    has Str $.app-display   = {{ app_display_q }};
    has Str $.app-version   = {{ app_version_q }};
    has Str $.repo          = {{ repo_q }};
    has Str $.installer-rel = {{ installer_rel_q }};

    has Callable $.clock     = -> { now.Int };
    has Callable $.transport = -> Str:D $url { self!discover($url) };
    has Callable $.prompt    = -> Str:D $version { self!prompt-user($version) };
    has Callable $.install   = -> Str:D $version { self!install-version($version) };
    has Callable $.exit      = -> Int:D $status { exit $status };
    has Callable $.dispatch  = -> { self!dispatch-app };
    has Callable $.terminal  = -> { $*IN.t && $*OUT.t && $*ERR.t };
    has Callable $.physical-current = -> IO::Path:D $root {
        self!is-managed-current($root)
    };
    has Hash $.env = %*ENV;

    method valid-version(Str:D $version --> Bool:D) {
        so $version ~~ /^ <[0..9]>+ '.' <[0..9]>+ '.' <[0..9]>+ $/
    }

    # Component strings are normalised, not coerced to native Int, so a tag
    # larger than the machine word compares correctly and leading zeros remain
    # accepted.
    method version-cmp(Str:D $left, Str:D $right --> Int:D) {
        die 'invalid update version' unless self.valid-version($left)
                                         && self.valid-version($right);
        for $left.split('.') Z $right.split('.') -> ($a, $b) {
            my $aa = $a.subst(/^ '0'+ /, '') || '0';
            my $bb = $b.subst(/^ '0'+ /, '') || '0';
            return 1  if $aa.chars > $bb.chars;
            return -1 if $aa.chars < $bb.chars;
            return 1  if $aa gt $bb;
            return -1 if $aa lt $bb;
        }
        0
    }

    method latest-tag(Str:D $url --> Str) {
        my $prefix = "https://github.com/{$!repo}/releases/tag/";
        return Str unless $url.starts-with($prefix);
        my $tag = $url.substr($prefix.chars);
        return Str if !$tag.chars
                   || $tag.contains('/')
                   || $tag.contains('?')
                   || $tag.contains('#')
                   || $tag.contains('%');
        self.valid-version($tag) ?? $tag !! Str
    }

    method eligible(IO::Path:D $bundle-root, @args --> Bool:D) {
        return False unless $!terminal();
        return False if @args.first({ $_ eq '--help' || $_ eq '--version' });
        return False if $!env<CI>:exists;
        return False if ($!env<ARIZA_NO_UPDATE_CHECK> // '') eq '1';
        return False if $!env{RELAUNCHED-ENV}:exists;
        my $has-handoff = $!env{HANDOFF-ENV}:exists;
        my $has-nonce   = $!env{NONCE-ENV}:exists;
        return False unless $has-handoff && $has-nonce;
        my $handoff = $!env{HANDOFF-ENV} // '';
        my $nonce   = $!env{NONCE-ENV} // '';
        return False unless $handoff.chars <= MAX-STATE-BYTES
                     && $handoff.IO.is-absolute
                     && $nonce ~~ /^ <[0..9a..f]> ** 64 $/;
        return False unless $!physical-current($bundle-root);
        my $state = self.state-root($bundle-root);
        return False if $state.parent.l || $state.l;
        True
    }

    method state-root(IO::Path:D $bundle-root --> IO::Path:D) {
        $bundle-root.parent.parent.add('.ariza').add('update-v1')
    }

    method read-state(IO::Path:D $path, Str:D :$kind! --> Str) {
        return Str unless $path.f;
        return Str if $path.s > MAX-STATE-BYTES;
        my $value = try { $path.slurp(:enc<ascii>).trim };
        return Str unless $value.defined && $value.chars;
        given $kind {
            when 'version' { self.valid-version($value) ?? $value !! Str }
            when 'timestamp' { $value ~~ /^ <[0..9]>+ $/ ?? $value !! Str }
            default { Str }
        }
    }

    method write-state(IO::Path:D $path, Str:D $value --> Bool:D) {
        return False if $value.encode('utf8').bytes > MAX-STATE-BYTES;
        my $ok = try {
            self!ensure-dir($path.parent);
            my $part = $path.parent.add(
                $path.basename ~ ".tmp-{$*PID}-{(^1_000_000).pick}");
            LEAVE $part.unlink if $part.e;
            $part.spurt($value ~ "\n", :enc<ascii>);
            $part.rename($path, :createonly(False));
            True
        };
        so $ok
    }

    method ignored(IO::Path:D $state, Str:D $version --> Bool:D) {
        $state.add('ignored').add($version).f
    }

    method ignore(IO::Path:D $state, Str:D $version --> Bool:D) {
        return False unless self.valid-version($version);
        self.write-state($state.add('ignored').add($version), $version)
    }

    method due(IO::Path:D $state, Int:D $now --> Bool:D) {
        my $raw = self.read-state($state.add('last-attempt'), :kind<timestamp>);
        return True unless $raw.defined;
        my $last = try { $raw.Int };
        return True unless $last.defined;
        return True if $last > $now; # clock rollback resets the cadence
        $now - $last >= CADENCE
    }

    method acquire-lock(IO::Path:D $state --> IO::Handle) {
        my $handle = try {
            self!ensure-dir($state);
            $state.add('lock').open(:a);
        };
        return IO::Handle unless $handle.defined;
        my $locked = try { $handle.lock(:non-blocking) };
        unless $locked {
            $handle.close;
            return IO::Handle;
        }
        $handle
    }

    method state-valid(IO::Path:D $state --> Bool:D) {
        my $last = $state.add('last-attempt');
        return False if $last.e
            && !self.read-state($last, :kind<timestamp>).defined;
        my $pending = $state.add('pending-version');
        return False if $pending.e
            && !self.read-state($pending, :kind<version>).defined;
        my $ignored = $state.add('ignored');
        return False if $ignored.e && !$ignored.d;
        if $ignored.d {
            for $ignored.dir -> $entry {
                return False unless $entry.f
                    && self.valid-version($entry.basename)
                    && self.read-state($entry, :kind<version>).defined
                    && self.read-state($entry, :kind<version>) eq $entry.basename;
            }
        }
        True
    }

    method candidate(IO::Path:D $state, Int:D $now --> Str) {
        my $pending = self.read-state($state.add('pending-version'), :kind<version>);
        if $pending.defined {
            return $pending if self.version-cmp($pending, $!app-version) > 0
                               && !self.ignored($state, $pending);
            try { $state.add('pending-version').unlink }
        }
        return Str unless self.due($state, $now);

        # The timestamp is committed before the bounded network call. Offline
        # launches therefore wait one cadence instead of hammering GitHub.
        return Str unless self.write-state($state.add('last-attempt'), ~$now);
        my $url = try { $!transport("https://github.com/{$!repo}/releases/latest") };
        return Str unless $url.defined && $url ~~ Str;
        my $version = self.latest-tag($url);
        return Str unless $version.defined;
        return Str unless self.version-cmp($version, $!app-version) > 0;
        return Str if self.ignored($state, $version);
        return Str unless self.write-state($state.add('pending-version'), $version);
        $version
    }

    method run(IO::Path:D :$bundle-root!, :@args = @*ARGS --> Mu) {
        return $!dispatch() unless self.eligible($bundle-root, @args);
        my $state = self.state-root($bundle-root);
        my $lock = self.acquire-lock($state);
        return $!dispatch() unless $lock.defined;
        LEAVE {
            try { $lock.unlock }
            try { $lock.close }
        }
        return $!dispatch() unless self.state-valid($state);

        my $candidate = self.candidate($state, $!clock().Int);
        return $!dispatch() unless $candidate.defined;

        given $!prompt($candidate) {
            when 'install' {
                # Installer failures are deliberately visible. Discovery and
                # state failures are policy noise; a chosen failed install is
                # an action the user needs explained.
                my $status = try { $!install($candidate) };
                if $status.defined && $status == 0 {
                    try { $state.add('pending-version').unlink }
                    return $!exit(75);
                }
                else {
                    my $why = $! ?? $!.message !! "installer exited unsuccessfully";
                    note "{$!app-display}: could not install $candidate: $why";
                }
            }
            when 'ignore' {
                self.ignore($state, $candidate);
                try { $state.add('pending-version').unlink }
            }
            default { } # ask next time: pending candidate stays intact
        }
        $!dispatch()
    }

    method !discover(Str:D $url --> Str) {
        if $!installer-rel.ends-with('.ps1') {
            # Windows PowerShell 5.1 is part of the installer contract; curl
            # is not. Keep discovery on that same baseline and return only
            # the final redirect URL for the strict repository/tag parser.
            my $script = q[$ErrorActionPreference = 'Stop'; $response = Invoke-WebRequest -UseBasicParsing -Uri $args[0] -MaximumRedirection 1 -TimeoutSec 10; [Console]::Out.Write($response.BaseResponse.ResponseUri.AbsoluteUri)];
            my $proc = try {
                run 'powershell.exe', '-NoLogo', '-NoProfile', '-NonInteractive',
                    '-Command', $script, $url, :out, :err
            };
            return Str unless $proc.defined;
            my $out = $proc.out.slurp(:close).trim;
            $proc.err.slurp(:close);
            return $proc.exitcode == 0 ?? $out !! Str;
        }

        my @cmd = 'curl', '--silent', '--show-error', '--fail',
                  '--location', '--connect-timeout', '3', '--max-time', '10',
                  '--proto', '=https', '--proto-redir', '=https',
                  '--max-redirs', '1', '--output', $*SPEC.devnull,
                  '--write-out', '%{url_effective}', $url;
        my $proc = try { run |@cmd, :out, :err };
        if $proc.defined {
            my $out = $proc.out.slurp(:close).trim;
            $proc.err.slurp(:close);
            return $out if $proc.exitcode == 0;
        }

        # Minimal POSIX systems sometimes carry wget rather than curl. Its
        # response trace is bounded by one redirect; the caller still accepts
        # only the exact HTTPS GitHub release URL for this repository.
        my $wget = try {
            run 'wget', '--spider', '--server-response', '--max-redirect=1',
                '--timeout=10', $url, :out, :err
        };
        return Str unless $wget.defined;
        $wget.out.slurp(:close);
        my $headers = $wget.err.slurp(:close);
        return Str unless $wget.exitcode == 0;
        my @locations = $headers.lines.map(*.trim).grep({
            .lc.starts-with('location:')
        }).map({ .substr(.index(':') + 1).trim.words[0] // '' }).grep(*.chars);
        @locations ?? @locations.tail !! Str
    }

    method !prompt-user(Str:D $version --> Str) {
        note "{$!app-display} $version is available (currently {$!app-version}).\n";
        loop {
            note "1. Install & use\n2. Ask next time\n3. Don't ask again for this version";
            my $answer = $*IN.get;
            return 'later' unless $answer.defined && $answer.trim.chars;
            given $answer.trim {
                when '1' { return 'install' }
                when '2' { return 'later' }
                when '3' { return 'ignore' }
                default { note 'Choose 1, 2 or 3.' }
            }
        }
    }

    method !install-version(Str:D $version --> Int:D) {
        my $root = $?FILE.IO.resolve.parent.parent.parent;
        my $installer = $root.add($!installer-rel);
        die "private installer is missing at $installer" unless $installer.f;
        my $handoff = $!env{HANDOFF-ENV}
            // die 'runner did not provide a private handoff path';
        my $nonce = $!env{NONCE-ENV}
            // die 'runner did not provide a private handoff nonce';
        my @cmd = $installer.extension eq 'ps1'
            ?? ('powershell.exe', '-NoProfile', '-ExecutionPolicy', 'Bypass',
                '-File', $installer.absolute,
                '-ArizaUpdateCandidate', $version,
                '-ArizaHandoff', $handoff,
                '-ArizaNonce', $nonce,
                '-ArizaExpectedCurrent', $root.absolute)
            !! ($installer.absolute,
                '--ariza-update-candidate', $version,
                '--ariza-handoff', $handoff,
                '--ariza-nonce', $nonce,
                '--ariza-expected-current', $root.absolute);
        my $proc = run |@cmd;
        $proc.exitcode
    }

    method !dispatch-app() {
        # The installed zef stub calls run-script in this process. It reads the
        # existing @*ARGS and invokes the application's registered MAIN.
        CompUnit::RepositoryRegistry.run-script($!app-exec)
    }

    method !is-managed-current(IO::Path:D $root --> Bool:D) {
        my $managed = $root.parent.parent.add('current');
        return False unless $managed.e || $managed.l;
        my $resolved = try { $managed.resolve };
        $resolved.defined && $resolved.absolute eq $root.resolve.absolute
    }

    method !ensure-dir(IO::Path:D $dir --> IO::Path:D) {
        $dir.mkdir(:parents) unless $dir.d;
        die "could not create $dir" unless $dir.d;
        $dir
    }
}

sub ariza-update-coordinator(--> Mu) is export {
    Ariza::Update::Coordinator
}

# A launcher executes this file directly. EVALFILE-based tests get the class
# without accidentally dispatching an application MAIN.
if $*PROGRAM-NAME.IO.absolute eq $?FILE.IO.absolute {
    my $root = $?FILE.IO.resolve.parent.parent.parent;
    Ariza::Update::Coordinator.new.run(:bundle-root($root));
}
