New bot: Releasable (with tests)

Automatically detects release dates, commits that were logged, etc. Also, prints warnings if something is not quite right. Technically, “changelogable” would be more precise (given that the bot does not make releases itself), but “releasable” is easier to remember. The data is taken from the rakudo repo directly (docs/ChangeLog, docs/release_guide.pod, VERSION). This means that no special actions should be taken to keep the bot up-to-date. Anyone can edit the changelog and the bot will pick up these changes automatically. Commits that should not be logged must be mentioned in one of the commits to the changelog file. This is possibly LTA, but we will see how it goes. Generally, this is an experiment in making the release process more awesome. Whether it is going to work better or not, I don't know. In any case, this is an independent bot that can be used in addition to anything else. There is a dependency on R6 to check for release blockers. As of today, there are no plans to change that (mainly because the whitelist approach of R6 is pretty much flawless). One of the cool features of releasable is that you can give it a link to the modified changelog file, and it will give you the information about it as if it was in rakudo repo (e.g. commits that are not logged and which ones are logged incorrectly). By the way, there's room for implementing other checks. Which abbreviated hash length the bot should enforce is debatable. Currently, it suggests the sha length of 8, and I was thinking about increasing it to 12. In the end I decided not to, but here was my logic: * From 2016.11 to 2017.04.2, seven characters were used. * 2017.04.3 had ten character shas in the changelog. * From 2017.05 to 2017.07, shas had eight characters. * If you ask git to give you an abbreviated hash, it gives nine characters. * It makes little sense to use abbreviated hashes that are smaller than what git produces. * Therefore, let's bump it to 9 characters… * However, git project repo already has collisions with 8 characters and linux repo has collisions with 9, so in a long run even 9 is not that good of an idea… * So let's use 12. * But even 12 may at some point may stop being sufficient (it's never enough). * Instead, let's keep it at 8. Once we start approaching birthday collisions for some length, we can bump it in the whole changelog. And there you go! Yet another blog post in a commit message 😉
Raku · Aug 14, 2017 · 5d7445b · 5d7445b
1 parent a1aa0e5
commit 5d7445b
Show file tree

Hide file tree

Showing 3 changed files with 348 additions and 1 deletion.
diff --git a/bin/Releasable.p6 b/bin/Releasable.p6
@@ -0,0 +1,187 @@
+#!/usr/bin/env perl6
+# Copyright © 2017
+#     Aleks-Daniel Jakimenko-Aleksejev <alex.jakimenko@gmail.com>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Affero General Public License for more details.
+#
+# You should have received a copy of the GNU Affero General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use Whateverable;
+use Misc;
+
+use IRC::Client;
+
+unit class Releasable does Whateverable;
+
+# ↓ Git itself suggests 9 characters, and 12 characters may be a better
+# ↓ choice for the hundred-year language… but let's increase it only
+# ↓ when needed
+my $SHA-LENGTH   = 8;
+my $RELEASE-HOUR = 19; # GMT+0
+my $BLOCKERS-URL = ‘https://perl6.fail/release/blockers.json’;
+my $TICKET-URL   = ‘https://rt.perl.org/rt3/Public/Bug/Display.html?id=’;
+
+method help($msg) {
+    “status | status link”
+}
+
+sub ignored-commits() {
+    my $last-release = to-full-commit chomp slurp “$RAKUDO/VERSION”;
+    die ‘Cannot resolve the tag for the last release’ unless $last-release;
+    my $result = run :out, :cwd($RAKUDO), ‘git’, ‘log’, ‘--pretty=%b’,
+                     ‘-z’, “$last-release..HEAD”, ‘--’, ‘docs/ChangeLog’;
+    die ‘Cannot git log the changelog’ unless $result;
+
+    return gather for $result.out.split(0.chr, :skip-empty) {
+        next unless /‘not logged’\N*‘:’ \s* [ @<shas>=[<.xdigit>**4..* ] ]+ % \s+/;
+        { take ~$_ if .chars == $SHA-LENGTH } for @<shas>
+    }
+}
+
+sub time-left($then) {
+    my $time-left = $then.Instant - now;
+    my ($seconds, $minutes, $hours, $days) = $time-left.polymod: 60, 60, 24;
+    return ‘is just a few moments away’ if not $days and not $hours;
+    my $answer = ‘in ’;
+    $answer ~= “$days day{$days ≠ 1 ?? ‘s’ !! ‘’} and ” if $days;
+    $answer ~= “≈$hours hour{$hours ≠ 1 ?? ‘s’ !! ‘’}”;
+    $answer
+}
+
+sub time-to-release($msg) {
+    my $guide = slurp “$RAKUDO/docs/release_guide.pod”;
+    die ‘Unable to parse the release guide’ unless $guide ~~ /
+    ^^ ‘=head2 Planned future releases’ $$
+    .*?
+    (^^‘  ’(\d\d\d\d‘-’\d\d‘-’\d\d)\s+ ‘Rakudo #’(\d+) [\s+‘(’ (<-[)]>+) ‘)’]? \n)+
+    /;
+    my @dates = $0.map: { %(date => Date.new(~.[0]), id => +.[1], manager => (.Str with .[2])) };
+    my $important-date;
+    my $annoying-warning = False;
+    for @dates {
+        my $release = .<date>.yyyy-mm-dd.split(‘-’)[0,1].join: ‘.’;
+        if not to-full-commit $release {
+            $important-date = $_;
+            if not .<manager> and not $annoying-warning {
+                $msg.reply: “Release manager is not specified yet.”
+            }
+            last
+        }
+        if not $annoying-warning {
+            $annoying-warning = True;
+            $msg.reply: “Release date for Rakudo $release is listed in”
+                  ~ “ “Planned future releases”, but it was already released.”;
+        }
+    }
+    die ‘Release date not found’ without $important-date;
+    my $time-left = time-left DateTime.new(date => $important-date<date>,
+                                           hour => $RELEASE-HOUR);
+    “Next release $time-left”
+}
+
+sub changelog-to-stats($changelog) {
+    if not $changelog.match: /^ ‘New in ’ (.*?) ‘:’ (.*?) ^^ ‘New in ’ (.*?) ‘:’/ {
+        return { summary => ‘Unknown changelog format’ }
+    }
+    my ($version, $changes, $version-old) = ~$0, ~$1, ~$2;
+
+    my $actual-commit = to-full-commit $version;
+    with $actual-commit {
+        return { summary => ‘Changelog for this release was not started yet’ }
+    }
+    my $actual-commit-old = to-full-commit $version-old;
+    die ‘Cannot resolve the tag for the previous release’ without $actual-commit-old;
+
+    my @shas = $changes.match(:g, / [‘[’ (<.xdigit>**4..*) ‘]’ \s*]+ $$/)»[0].flat».Str;
+    my $result = run :out, :cwd($RAKUDO), ‘git’, ‘log’, ‘-z’, ‘--pretty=%H’,
+                     ‘--reverse’, “$actual-commit-old..HEAD”;
+    die ‘Failed to query rakudo git log’ unless $result;
+    my @git-commits = $result.out.slurp-rest.split(0.chr, :skip-empty)
+                                            .map: *.substr: 0, $SHA-LENGTH;
+    my @warnings;
+    my $commit-mentioned = set gather for @shas {
+        when .chars ≠ $SHA-LENGTH {
+            @warnings.push: “$_ should be $SHA-LENGTH characters in length”
+        }
+        when @git-commits.none {
+            @warnings.push: “$_ was referenced but there is no commit with this id”
+        }
+        default { take $_ }
+    }
+    my $ignored = set ignored-commits;
+    my @unlogged = @git-commits.grep: * !∈ ($commit-mentioned ∪ $ignored); # ordered
+    my $summary = “{@git-commits - @unlogged} out of {+@git-commits} commits logged”;
+    { :$summary, :@unlogged, :@warnings }
+}
+
+sub blockers() {
+    use HTTP::UserAgent;
+    my $ua = HTTP::UserAgent.new;
+    my $response = try { $ua.get: $BLOCKERS-URL };
+    return { summary => ‘R6 is down’ } without $response;
+    return { summary => ‘R6 is down’ } unless $response.is-success;
+    if $response.content-type ne ‘application/json;charset=UTF-8’ {
+        return { summary => ‘R6 is weird’ }
+    }
+    my %data = from-json $response.decoded-content;
+    return { summary => ‘R6 is weird’ } unless %data<tickets>:exists;
+    my @tickets = %data<tickets>.list;
+    return { summary => ‘No blockers’ } unless @tickets;
+    my $summary = “{+@tickets} blocker{@tickets ≠ 1 ?? ‘s’ !! ‘’}”;
+    {:$summary, :@tickets}
+}
+
+multi method irc-to-me($msg where /^ \s* [changelog|status|release|when]‘?’?
+                                    [\s+ $<url>=[‘http’.*]]? $/) {
+    my $changelog = process-url ~$_, $msg        with    $<url>;
+    $changelog  //= slurp “$RAKUDO/docs/ChangeLog”;
+    my $answer    = time-to-release($msg) ~ ‘. ’ without $<url>;
+    my %stats     = changelog-to-stats $changelog;
+    my %blockers  = blockers                     without $<url>;
+
+    # ↓ All code here just to make the message pretty ↓
+    $answer ~= “$_. ” with %blockers<summary>;
+    $answer ~= %stats<summary>;
+    $answer ~= “ (⚠ {+%stats<warnings>} warnings)” if %stats<warnings>;
+    $msg.reply: $answer;
+    return if none %blockers<tickets>, %stats<unlogged>, %stats<warnings>;
+
+    # ↓ And here just to make a pretty gist ↓
+    my &escape-html = { .trans: (‘&’, ‘<’, ‘>’) => (‘&amp;’, ‘&lt;’, ‘&gt;’) };
+    my %files;
+
+    my $blockers = join “\n”, (%blockers<tickets> // ()).map: { ‘<a href="’
+                              ~ $TICKET-URL ~ .<ticket_id> ~ ‘">RT #’
+                              ~ .<ticket_id> ~ ‘</a> ’ ~ escape-html .<subject> };
+    %files<!blockers!.md> = ‘<pre>’ ~ $blockers ~ ‘</pre>’ if %blockers<tickets>;
+
+    my $warnings = .join(“\n”) with %stats<warnings>;
+    %files<!warnings!> = $warnings if $warnings;
+
+    with %stats<unlogged> {
+        my $descs = run :out, :cwd($RAKUDO), ‘git’, ‘show’,
+                        ‘--format=%s’,
+                        “--abbrev=$SHA-LENGTH”, ‘--quiet’, |$_;
+        my $links = run :out, :cwd($RAKUDO), ‘git’, ‘show’,
+                        ‘--format=[<a href="’ ~ $RAKUDO-REPO ~ ‘/commit/%H">%h</a>]’,
+                        “--abbrev=$SHA-LENGTH”, ‘--quiet’, |$_;
+        my $unreviewed = join “\n”, ($descs.out.lines Z $links.out.lines).map:
+                         {‘    + ’ ~ escape-html(.[0]) ~ ‘ ’ ~ .[1]};
+        %files<unreviewed.md> = ‘<pre>’ ~ $unreviewed ~ ‘</pre>’ if $unreviewed;
+    }
+    (‘’ but FileStore(%files)) but PrettyLink({“Details: $_”})
+}
+
+Releasable.new.selfrun: ‘releasable6’, [ / release6? <before ‘:’> /,
+                                         fuzzy-nick(‘releasable6’, 2) ]
+
+# vim: expandtab shiftwidth=4 ft=perl6
diff --git a/lib/Whateverable.pm6 b/lib/Whateverable.pm6
@@ -30,7 +30,9 @@ use Text::Diff::Sift4;
 
 use Misc;
 
-our $RAKUDO = ‘./data/rakudo-moar’.IO.absolute;
+our $RAKUDO = (%*ENV<TESTABLE> // ‘’).contains(‘rakudo-mock’)
+              ?? ‘./t/data/rakudo’.IO.absolute
+              !! ‘./data/rakudo-moar’.IO.absolute;
 constant MOARVM = ‘./data/moarvm’.IO.absolute;
 constant CONFIG = ‘./config.json’.IO.absolute;
 constant SOURCE = ‘https://github.com/perl6/whateverable’;
@@ -43,6 +45,8 @@ constant MESSAGE-LIMIT is export = 260;
 constant COMMITS-LIMIT = 500;
 constant PARENTS = ‘AlexDaniel’, ‘MasterDuke’;
 
+our $RAKUDO-REPO = ‘https://github.com/rakudo/rakudo’;
+
 constant Message = IRC::Client::Message;
 
 unit role Whateverable[:$default-timeout = 10] does IRC::Client::Plugin does Helpful;

diff --git a/t/releasable.t b/t/releasable.t
@@ -0,0 +1,156 @@
+#!/usr/bin/env perl6
+BEGIN %*ENV<PERL6_TEST_DIE_ON_FAIL> = 1;
+%*ENV<TESTABLE> = ‘rakudo-mock’;
+
+use lib ‘t/lib’;
+use File::Directory::Tree;
+use IRC::Client;
+use Test;
+use Testable;
+
+my $t = Testable.new: bot => ‘Releasable’;
+
+$t.common-tests: help => “status | status link”;
+
+$t.shortcut-tests: <release: release6:>,
+                   <release release, release6 release6,>;
+
+# The idea is to generate a pseudorealistic repo that
+# is good enough for testing purposes.
+
+my $mock = ‘t/data/rakudo’.IO;
+rmtree $mock if $mock.e;
+mkdir $mock;
+run :cwd($mock), :out(Nil), ‘git’, ‘init’;
+mkdir $mock.add: ‘docs’;
+spurt $mock.add(‘docs/ChangeLog’), “New in 2090.07:\n + Additions:\n\n”;
+
+my @releases = (
+    ‘2090-08-19   Rakudo #990 (AlexDaniel)’,
+    ‘2090-09-16   Rakudo #991’,
+    ‘2090-10-21   Rakudo #992’,
+    ‘2090-11-18   Rakudo #993’,
+);
+
+sub changelog(Block $do) {
+    my $path = $mock.add: ‘docs/ChangeLog’;
+    spurt $path, $do(slurp $path);
+}
+
+sub tag-last($tag-name, $new-section = “New in {$tag-name + 0.01}”  #← hahaha
+                                     ~ “:\n + Additions:\n\n”     ) {
+    my $sha = run(:cwd($mock), :out, ‘git’, ‘rev-parse’, ‘HEAD’)
+              .out.slurp-rest.chomp;
+    run :cwd($mock), ‘git’, ‘tag’, ‘--annotate’,
+                     “--message=Blah $tag-name”, $tag-name;
+    spurt $mock.add(‘VERSION’), $tag-name;
+    changelog { $new-section ~ $_ } if defined $new-section
+}
+
+sub commit($message, :$log = True) {
+    my $foo = ^9⁹ .pick;
+    spurt $mock.add($foo), $foo;
+    run :cwd($mock),            ‘git’, ‘add’, ‘--’, $foo;
+    run :cwd($mock), :out(Nil), ‘git’, ‘commit’, “--message=$message”;
+
+    my $release-guide = “=head2 Planned future releases\n\n… … …\n\n”
+                       ~ @releases.map({ “  $_\n” }).join;
+    spurt $mock.add(‘docs/release_guide.pod’), $release-guide;
+
+    my $sha = run(:cwd($mock), :out, ‘git’, ‘rev-parse’, ‘HEAD’)
+              .out.slurp-rest.chomp.substr: 0, 8;
+    my $log-entry = $log ~~ Bool ?? “    + $message [$sha]\n” !! $log;
+    changelog -> $file is copy {
+        die without $file ~~ s/<after \n><before \n>/$log-entry/;
+        $file
+    } if $log;
+    $sha
+}
+
+# TODO the number of blockers and the time left is not controllable
+
+# Basics
+
+commit ‘$!.pending (RT #68320)’;
+
+$t.test(‘unknown format’,
+        “{$t.bot-nick}: when?”,
+        /^ <me($t)>‘, Next release in ’\d+‘ day’s?‘ and ≈’\d+‘ hour’s?‘. ’
+           [ \d+‘ blockers’ | ‘No blockers’ ]‘. ’
+           ‘Unknown changelog format’ $/,
+        “{$t.our-nick}, Details: https://whatever.able/fakeupload”);
+
+
+tag-last ‘2090.07’;
+commit ‘.hyper and .race finally re-added’;
+tag-last ‘2090.08’, Nil;
+
+$t.test(‘not started yet’,
+        “{$t.bot-nick}: status”,
+        “{$t.our-nick}, Release date for Rakudo 2090.08 is listed in”
+            ~ “ “Planned future releases”, but it was already released.”,
+        /^ <me($t)>‘, Next release in ’\d+‘ day’s?‘ and ≈’\d+‘ hour’s?‘. ’
+           [ \d+‘ blockers’ | ‘No blockers’ ]‘. ’
+           ‘Changelog for this release was not started yet’ $/,
+        “{$t.our-nick}, Details: https://whatever.able/fakeupload”);
+
+
+@releases.shift;
+
+my $to-be-logged     = commit ‘A change that should be logged’,     :!log;
+my $to-be-logged-not = commit ‘A change that should not be logged’, :!log;
+my @real = ‘Furious whitespace changes’ xx 4;
+@real.push: ‘Fix nothing’;
+@real .= map: { commit $_, :!log };
+my $log-entries = qq:to/END/;
+New in 2090.09:
+ + Deprecations:
+    + Deprecate everything [de1e7ea1]
+ + Fixes:
+    + Fix nothing [@real[*-1]]
+    + Furious whitespace changes [@real[0]] [@real[1]] [@real[2]]
+        [@real[3]] [abcabcabcabc]
+    + No really, this change is very important [@real[1]]
+
+END
+changelog { $log-entries ~ $_ };
+
+run :cwd($mock), ‘git’, ‘add’, ‘--’, ‘docs/ChangeLog’;
+commit “Changelog\n\nIntentionally not logged: $to-be-logged-not”, :!log;
+
+$t.test(‘realistic output’,
+        “{$t.bot-nick}: release”,
+        “{$t.our-nick}, Release manager is not specified yet.”,
+        /^ <me($t)>‘, Next release in ’\d+‘ day’s?‘ and ≈’\d+‘ hour’s?‘. ’
+           [ \d+‘ blockers’ | ‘No blockers’ ]‘. ’
+           ‘6 out of 8 commits logged (⚠ 2 warnings)’ $/, # TODO ideally should be 7 out of 8
+        “{$t.our-nick}, Details: https://whatever.able/fakeupload”);
+
+$t.test-gist(‘gisted files look alright’,
+             %(‘!warnings!’    =>
+                 ‘de1e7ea1 was referenced but there is no commit with this id’
+                 ~ “\n” ~ ‘abcabcabcabc should be 8 characters in length’,
+               ‘unreviewed.md’ =>
+                 /｢<pre>    + A change that should be logged｣
+                  ｢ [<a href="https://github.com/rakudo/rakudo/commit/｣
+                  $to-be-logged <.xdigit>+ ｢">｣ $to-be-logged ｢</a>]｣.*｢</pre>｣ # TODO .*
+                 /,
+              )
+            );
+
+
+$t.test(‘uncommitted changed from a link’,
+        “{$t.bot-nick}: changelog https://gist.github.com/AlexDaniel/45b98a8bd5935a53a3ed4762ea5f5d43/raw/”,
+        “{$t.our-nick}, Successfully fetched the code from the provided URL.”,
+        “{$t.our-nick}, 1 out of 8 commits logged”,
+        “{$t.our-nick}, Details: https://whatever.able/fakeupload”);
+
+# $t.last-test; # Deliberately no $t.last-test! (we can't repeat the first test)
+$t.test(‘No uncaught messages’,
+        “{$t.bot-nick}: help”,
+        /^ <me($t)>‘, status | status link’ /);
+
+done-testing;
+END $t.end;
+
+# vim: expandtab shiftwidth=4 ft=perl6