discord-rakubot.raku

#! /bin/env raku
use v6.*;

use API::Discord;
use IRC::Client;
use Shell::Piping;

use uniname-words; # We need to force a precomp to help Restricted.rakumod .

sub infix:<␣>(\l, \r) { l ~ ' ' ~ r }
constant term:<¶> = $?NL;
sub spy(|c) { dd c; c }

# On Discord bots are tied to user accounts. Control over bots can not be
# transfered. There are teams on Discord similiar to orgs on github. Not sure
# if control can be shared via those. A bot has to be invited to a server by
# the "owner" of that server. Ofc, Discord Inc. owns everything but they are
# willing to give you a crown. timotimo is involed so he should be able to help
# you to get the bot invited or take ownership of the bot and give you the
# keys.
#
# Messages can be updated on Discord. This script takes that into account.
#
# Usernames on discord have to be unique. They achive this by adding /'#' \d ** # 4/
# to usernames. This script follows suit.

# Setting up a bot is explained here:
# https://www.howtogeek.com/364225/how-to-make-your-own-discord-bot/
# https://discord.com/developers/applications/853712446660673566/information
# raku-bot-dev https://discord.com/oauth2/authorize?client_id=855866121503375370&scope=bot&permissions=68608

# my $*discord-channels = '#general#raku';
# my $*discord-channels = '#-raku-irc#-raku-dev-irc#-moarvom-irc#-webring-irc';


multi sub augment(Discord::Channel \s) {
    s does role :: {
        method Str { ‚#‘ ~ self.name }
    }
}

multi sub augment(%author where { .<discriminator>:exists }, API::Discord:D $discord, $channel) {
    $discord.get-user(%author<id>) does role :: {
        method Str { self.nick }
        method nick { 
            $channel.guild.get-member(self.id).&{ .nick // .user.username }.Str
        }
    }
}

multi sub augment(API::Discord::User $user, $channel) {
    $user does role :: {
        method Str { self.nick }
        method nick { 
            $channel.guild.get-member(self.id).&{ .nick // .user.username }.Str
        }
    }
}

multi sub augment(|c) {
    c
}

my &guilds = sub { [] }
my &discord-channels = sub { [] }
my &irc-send-message = sub (Str:D $channel, Str:D $message) { }
my &discord-user = sub ($id) { '<users not know yet>' }

constant all-channels := none();

sub discord-log-stream($token = %*ENV<DISCORD_TOKEN> // $*discord-token, Mu:D :$channels is copy = %*ENV<DISCORD_CHANNELS> // $*discord-channels // all-channels) {
    my $discord = API::Discord.new(:$token);
    my $result = Supplier::Preserving.new;

    $channels = $channels.split('#').&{ any( .cache.grep(/^ '-'/)».subst(/^ '-'/).none, .grep(/^ <-[-]>/).any) }

    $discord.connect;
    # await $discord.ready;

    start react {
        whenever $discord.ready {
            note "Logged in as { $discord.user.username }.";
            &guilds = sub { $discord.guilds.values }
            &discord-channels = sub { $discord.channels.values }
            &discord-user = sub ($id) { $discord.get-user($id).&augment }
        }
        whenever $discord.messages -> $message {
            # next unless $channels ~~ $message.channel.name;

            $result.emit: [ $message.channel.&augment, $message.author.&augment($message.channel), $message.content ];
        }
        whenever $discord.events -> $event {
            if $event<t> eq 'MESSAGE_UPDATE' {
                my $m = $event<d>;
                my $channel = $discord.get-channel($m<channel_id>).&augment;
                my $author = $m<author>.&augment($discord, $channel);
                # next unless $channels ~~ $channel.name;
                
                $result.emit: [ $channel, $author, $m<content>, :update ];
            }
        }
        # FIXME
        # whenever signal(SIGINT) {
        #     $result.done()
        # }
        {
            use API::Discord::Debug;

            whenever debug-say().merge(debug-print()) {
                when HEARTBEAT { }
                when CONNECTION { note now.DateTime.Str, ' ', $_ }
                default {}
            }

        }
        CATCH { default { warn .^name ␣ .Str } }
    }

    $result.Supply
}

my regex identifier {
    <[a..z A..Z 0..9 . -]>+
}

sub irc-bridge-stream(*@channels where { .all ~~ /<identifier>+ '#' <identifier>/}, :$irc-bot-nick) {
    my \irc-messages = Supplier::Preserving.new;

    for @channels.map({ m/(<identifier>) '#' (<identifier>)/.list».Str }).classify(*.[0], :as(*.[1])) -> Pair (:key($server), :value(@channels)) {
        start IRC::Client.new(:host($server), :channels('#' «~« @channels), :nick($irc-bot-nick), :plugins(
            class {
                has $.current-nick;
                method irc-privmsg-channel ($_){ irc-messages.emit: [.server.host, .channel.subst(/^ '#'/, ''), .nick, .text]; Nil }
                method irc-connected($self) { 
                    note „connected to {$self.server.host} as {$self.args[0]}“;
                    &irc-send-message = sub (Str:D $channel, Str:D $message) {
                        $self.irc.send: :where($channel) :text($message);
                    }

                    Nil 
                }
            })
        ).run;
    }

    irc-messages.Supply
}

sub merge-spammers(Supply:D() $in --> Supply:D) {
    my $out := Supplier::Preserving.new;

    start react {
        my @buffer;
        my $flush := Supplier.new;
        whenever $in -> @a {
            @buffer.push: @a;
            Promise.in(5).then: { $flush.emit: True }
        }
        whenever $flush {
            next unless @buffer;

            my @result;
            while +@buffer {
                my $left = @buffer.shift;
                if +@buffer {
                    my $right = @buffer.head;
                    if $left[2] eq $right[2] {
                        @buffer.shift;
                        $left = [ |$left[0,1,2], ($left[3].starts-with(¶) ?? $left[3] !! ¶ ~ $left[3]) ~ ¶ ~ $right[3] ];
                        @buffer.unshift: $left;
                    } else {
                        @result.push: $left;
                    }
                } else {
                    @result.push: $left;
                }
            }

            $out.emit: .item for @result;
            @buffer = [];
        }
    }

    $out.Supply
}

sub MAIN(:$discord-token, :$*prefix = '.') {
    my %cfg = load-config($*prefix.IO.add('.discord-raku-bot.cfg'));
    my $*discord-token = $discord-token // %cfg<discord><token>;
    my $irc-bot-nick = %cfg<irc><nick>;
    my $discord-server-name = %cfg<discord><servername>;
    my $discord-bot-nick = %cfg<discord><nick>;
    my $discord-client-id = %cfg<discord><clientid>;
    my @discord-bridge-channels = %cfg<discord><bridge><channels>.split(' ');
    my @irc-bridge-channels = %cfg<irc><channels>.split(' ');
    my $start-time = now;

    say "invite with: https://discord.com/oauth2/authorize?client_id=$discord-client-id&scope=bot&permissions=68608";

    %*ENV<RAKUDO_ERROR_COLOR> = 0;
    %*ENV{%*ENV.grep(/^ SSH/)».key}:delete;
    constant $response-max-chars = 1990;

    multi sub postfix:<minute>(Numeric() \seconds) { seconds * 60 }
    multi sub postfix:<minutes>(Numeric() \seconds) { seconds * 60 }
    multi sub postfix:<hour>(Numeric() \seconds) { seconds * 3600 }
    multi sub postfix:<hours>(Numeric() \seconds) { seconds * 3600 }
    multi sub postfix:<day>(Numeric() \seconds) { seconds * 86400 }
    multi sub postfix:<days>(Numeric() \seconds) { seconds * 86400 }

    # start react whenever Supply.interval(1day) {
    #     note ‚taking snapshot‘;
    #     use Perl6::Compiler:from<NQP>;
    #     sub compress(Str() $file-name) { run «lz4 -BD --rm -qf $file-name» }

    #     my $filename = 'raku-bot-' ~ now.DateTime.&{ .yyyy-mm-dd ~ '-' ~ .hh-mm-ss } ~ '.mvmheap';
    #     Perl6::Compiler.profiler-snapshot(kind => "heap", filename => $filename<>);
    #     $filename.&compress;

    #     note ‚done‘;
    # }

    react {
        whenever discord-log-stream() -> [ $channel, $username, $message is rw, :$update = False ] {
            next without $message;

            if $channel eq @discord-bridge-channels.any {
                say 'bot speaking' if $username eq $discord-bot-nick;

                # if $message ~~ / '<@!' (\d+) '>' / {
                #     try put '@' ~ discord-user($0.Str);
                # }

                try $message ~~ s/ '<@!' (\d+) '>' /{ '@' ~ discord-user($0.Str) }/;

                my @lines = $message.Str.split(¶, :skip-empty);
                irc-send-message($channel.Str.subst(/'-irc' $/, ''), „<$username>“ ␣ .Str) for @lines;

                next unless $channel eq '#raku-beginner'
            }

            if $message ~~ / 'use' \s+ 'nqp' / {
                $channel.send-message: 'Malicious intend detected! Orbital strike authorised.';

                next
            }

            $message = "m: $0" if $channel eq '#raku-beginner' && $message ~~ / ^ '<' \w+ '>' \s 'm:' (.*?) $ /;

            $message = "m: $0" if $message ~~ / ^ 'm:```' (.*?) '```' $ /;

            if $message ~~ / ^ 'm:' \s (.+) / -> Match (Str() $code, *@) {
                $code |» (px«raku -Ilib -M Test -M Restricted»:timeout(10)) |» my @response :stderr(my @stderr);
                my $response = @response.push(|@stderr[*;1]).join(¶);
                $response = $response.substr(0..$response-max-chars) if $response.chars ≥ $response-max-chars;
                $response = "```\n" ~ $response  ~ "```" ~ ($response.chars ≥ $response-max-chars ?? '…' !! '');
                $channel.send-message: $response;
                CATCH {
                    when X::Shell::NonZeroExitcode { $channel.send-message: "```\n" ~ @stderr[*;1].join(¶) ~ "```" }
                    default { $channel.send-message: "```\n" ~ .^name ␣ .message ~ "```"; }
                }

                next
            }

            if $message ~~ / '<@!' $discord-client-id '>' \s+ 'report' / {
                'say $*RAKU.compiler.version' |» px<raku> |» my @response :stderr(my @stderr);
                try $channel.send-message: "```\n" ~ @response.join(¶) ~ @stderr.join(¶) ~ "```";

                next
            }

            if $message ~~ / '<@!' $discord-client-id '>' \s+ 'restart' / {
                done;
            }

            if $message ~~ / '<@!' $discord-client-id '>' \s+ 'help' / {
                my $response = q:to/EOH/;
                m: my $s = "single line"; say $s;

                m:`​``
                my $s = "multi line";
                say $s;
                `​``

                @raku-bot restart
                EOH
                try $channel.send-message: "```\n" ~ $response ~ "```";

                next
            }
        }

        whenever irc-bridge-stream(@irc-bridge-channels, :$irc-bot-nick).&merge-spammers.&limit-rate -> [$irc-server, $irc-channel, $irc-user, $message, *%_]{
            # whenever irc-bridge-stream(<irc.libera.chat#gfldex-bot-test>, :$irc-bot-nick).&merge-spammers.&limit-rate -> [$irc-server, $irc-channel, $irc-user, $message, *%_]{
            next if $irc-user eq $irc-bot-nick;

            my $discord-channel = $irc-channel eq 'raku-beginner' ?? $irc-channel !! $irc-channel ~ '-irc';

            with discord-channels.grep({ .guild.name eq $discord-server-name && .name eq $discord-channel}).head {
                .send-message: „<*$irc-user*>“ ␣ $message;
            }
        }
    }
}

sub load-config(IO::Path() $path --> Hash) {
    my %hash;
    for $path.slurp.lines { m:g/ ^ \s* <?-[#]> ([ \w || <[-.]> ]+) \s* '=' \s* (.*) $ { 
        if $0.contains('.') {
            %hash{||$0.split('.')} = $1.Str
        } else {
            %hash{$0.Str} = $1.Str
        }
    } /; }

    %hash
}

sub limit-rate(Supply $in, $per-seconds = 1 --> Supply:D) {
    my $out = Supplier::Preserving.new;

    start react whenever $in -> \value {
        $out.emit: value;
        sleep(1 / $per-seconds);
    }

    $out.Supply;
}

# vim: expandtab shiftwidth=4

nqp.rakumod

sub EXPORT {
    die ‚Malicious intend detected! Orbital strike authorised.‘;
}

Restricted.rakumod

use uniname-words;

constant $stdin-text = qq:to/EOH/;
I ♥ Raku!
1 22 333 4444 55555 6565656
3.14159265358979323846264338327950288419716939937510582097494459
A line with the number 42.
We may need some "quotes".
A backslash \\
would be nice too.
\c[END OF TEXT]
EOH

sub fake-lines {
    gather .take for $stdin-text.split("\n");
}

sub fake-slurp(|) {
    fake-lines
}

sub fake-stdin(|) {
    $*IN = class :: is IO::Handle {
        has @.lines = $stdin-text.split("\n");
        method lines { gather { while @!lines { take shift @!lines } } }
        method nl-in(|) { }
        method chomp(|) { }
        method encoding(|) { }
        method IO { self }
        method open { self }
        method get { shift @!lines }
    }.new;

}

sub fake-get(|) {
    $*IN.get
}

sub EXPORT {
    IO::Path.^can('new')[0].wrap( -> | { die 'Restricted in evalbot.' });
    Proc::Async.^can('new')[0].wrap( -> | { die 'Restricted in evalbot.' });
    fake-stdin;
    Map.new: 
        '&slurp' => &fake-slurp,
        '&lines' => &fake-lines,
        '&get' => &fake-get,
        '&uniname-words' => &uniname-words
}