### ----------------------------------------------------
### -- Cro::HTTP
### -- Licenses: Artistic-2.0
### -- Authors: Jonathan Worthington <jnthn@jnthn.net>
### -- File: lib/Cro/HTTP/Router.rakumod
### ----------------------------------------------------
### -- Chunk 1 of 2
use Cro;
use Cro::BodyParser;
use Cro::BodyParserSelector;
use Cro::BodySerializer;
use Cro::BodySerializerSelector;
use Cro::HTTP::Auth;
use Cro::HTTP::LogTimelineSchema;
use Cro::HTTP::Middleware;
use Cro::HTTP::MimeTypes;
use Cro::HTTP::PushPromise;
use Cro::HTTP::Request;
use Cro::HTTP::Response;
use Cro::UnhandledErrorReporter;
use IO::Path::ChildSecure;

class X::Cro::HTTP::Router::OnlyInRouteBlock is Exception {
    has Str $.what is required;
    method message() {
        "Can only use '$!what' inside of a route block"
    }
}
class X::Cro::HTTP::Router::OnlyInHandler is Exception {
    has Str $.what is required;
    method message() {
        "Can only use '$!what' inside of a request handler"
    }
}
class X::Cro::HTTP::Router::NoRequestBodyMatch is Exception {
    method message() {
        "None of the request-body matches could handle the body (this exception " ~
        "type is typically caught and handled by Cro to produce a 400 Bad Request " ~
        "error; if you're seeing it, you may have an over-general error handling)"
    }
}

class X::Cro::HTTP::Router::ConfusedCapture is Exception {
    has $.body;
    has $.content-type;
    has $.signature;

    method message() {
        "The message body was parsed into '{ my $text = $!body.raku(); $text.chars > 500 ?? $text.substr(0, 500) ~ '...' !! $text }' of type ($!body.^name()), " ~
        "but a Block's signature '$!signature.raku()' { $!content-type ?? "for '$!content-type' " !! ' ' }" ~
        "could not unpack it, check if the signature fits the body?"
    }
}

module Cro::HTTP::Router {
    role Query {}
    multi trait_mod:<is>(Parameter:D $param, :$query! --> Nil) is export {
        $param does Query;
    }
    role Header {}
    multi trait_mod:<is>(Parameter:D $param, :$header! --> Nil) is export {
        $param does Header;
    }
    role Cookie {}
    multi trait_mod:<is>(Parameter:D $param, :$cookie! --> Nil) is export {
        $param does Cookie;
    }
    role Auth {}
    multi trait_mod:<is>(Parameter:D $param, :$auth! --> Nil) is export {
        $param does Auth;
    }

    #| Router plugins register themselves using the C<router-plugin-register>
    #| function, receiving in response a plugin key object. This is used to
    #| identify the plugin in further interactions with the plugin API.
    class PluginKey {
       has Str $.id is required;
    }

    #| A C<Cro::Transform> that consumes HTTP requests and produces HTTP
    #| responses by routing them according to the routing specification set
    #| up using the C<route> subroutine other routines. This class itself is
    #| considered an implementation detail.
    class RouteSet does Cro::Transform {
        role Handler {
            has @.prefix;
            has @.body-parsers;
            has @.body-serializers;
            has @.before-matched;
            has @.after-matched;
            has @.around;

            method copy-adding() { ... }
            method signature() { ... }
            method invoke(Cro::HTTP::Request $request, Capture $args) { ... }

            method !add-body-parsers(Cro::HTTP::Request $request --> Nil) {
                if @!body-parsers {
                    $request.body-parser-selector = Cro::BodyParserSelector::Prepend.new(
                        parsers => @!body-parsers,
                        next => $request.body-parser-selector
                    );
                }
            }

            method !add-body-serializers(Cro::HTTP::Response $response --> Nil) {
                if @!body-serializers {
                    $response.body-serializer-selector = Cro::BodySerializerSelector::Prepend.new(
                        serializers => @!body-serializers,
                        next => $response.body-serializer-selector
                    );
                }
            }

            method !append-body-serializers(Supply $pipeline --> Supply) {
                supply whenever $pipeline {
                    self!add-body-serializers($_);
                    emit $_;
                }
            }

            method !append-middleware(Supply $pipeline, @middleware, %connection-state --> Supply) {
                my $current = $pipeline;
                for @middleware -> $comp {
                    if $comp ~~ Cro::ConnectionState {
                        my $cs-type = $comp.connection-state-type;
                        with %connection-state{$cs-type} {
                            $current = $comp.transformer($current, :connection-state($_));
                        }
                        else {
                            my $cs = $cs-type.new;
                            %connection-state{$cs-type} = $cs;
                            $current = $comp.transformer($current, :connection-state($cs));
                        }
                    }
                    else {
                        $current = $comp.transformer($current);
                    }
                }
                $current
            }
        }

        my class RouteHandler does Handler {
            has Str $.method;
            has &.implementation;
            has Hash[Array, Cro::HTTP::Router::PluginKey] $.plugin-config;
            has Hash[Array, Cro::HTTP::Router::PluginKey] $.flattened-plugin-config;

            method copy-adding(:@prefix, :@body-parsers!, :@body-serializers!, :@before-matched!, :@after-matched!, :@around!,
                               Hash[Array, Cro::HTTP::Router::PluginKey] :$plugin-config) {
                self.bless:
                    :$!method, :&!implementation,
                    :prefix[flat @prefix, @!prefix],
                    :body-parsers[flat @!body-parsers, @body-parsers],
                    :body-serializers[flat @!body-serializers, @body-serializers],
                    :before-matched[flat @before-matched, @!before-matched],
                    :after-matched[flat @!after-matched, @after-matched],
                    :around[flat @!around, @around],
                    :$!plugin-config,
                    :flattened-plugin-config(merge-plugin-config($plugin-config, $!flattened-plugin-config // $!plugin-config))
            }

            sub merge-plugin-config($outer, $inner) {
                if $outer && $inner {
                    # Actually need to merge them.
                    my Array %merged{Cro::HTTP::Router::PluginKey};
                    for $inner.kv -> Cro::HTTP::Router::PluginKey $key, @configs {
                        %merged{$key}.append(@configs);
                    }
                    for $outer.kv -> Cro::HTTP::Router::PluginKey $key, @configs {
                        %merged{$key}.append(@configs);
                    }
                    %merged
                }
                elsif $inner {
                    # Nothing new from the outer, so just use inner
                    $inner
                }
                else {
                    # Only things from the outer
                    $outer
                }
            }

            method signature() {
                &!implementation.signature
            }

            method get-innermost-plugin-configs(Cro::HTTP::Router::PluginKey $key --> List) {
                $!plugin-config{$key}.List // ()
            }

            method get-plugin-configs(Cro::HTTP::Router::PluginKey $key --> List) {
                ($!flattened-plugin-config // $!plugin-config){$key}.List // ()
            }

            method !invoke-internal(Cro::HTTP::Request $request, Capture $args --> Promise) {
                my $*CRO-ROUTER-REQUEST := $request;
                my $response := my $*CRO-ROUTER-RESPONSE := Cro::HTTP::Response.new(:$request);
                my $*CRO-ROUTER-ROUTE-HANDLER := self;
                self!add-body-parsers($request);
                self!add-body-serializers($response);
                start {
                    {
                        my $log-timeline-task = $request.annotations<log-timeline>;
                        my $callback = -> {
                            &!implementation(|$args);
                        }
                        for @!around.reverse -> $around {
                            $callback = -> $fn { -> { $around($fn) } }($callback);
                        }
                        Cro::HTTP::LogTimeline::Handle.log: $log-timeline-task, $callback;
                        CATCH {
                            when X::Cro::HTTP::Router::NoRequestBodyMatch {
                                $response.status = 400;
                            }
                            when X::Cro::BodyParserSelector::NoneApplicable {
                                $response.status = 400;
                            }
                            when X::Cro::HTTP::Router::ConfusedCapture {
                                # This is likely a server-side error, but we should not
                                # leak this to our clients, so just return 400 for anyone
                                # who passes bad data and report a failure for the developer
                                report-unhandled-error($_);
                                $response.status = 400;
                            }
                            default {
                                report-unhandled-error($_);
                                $response.status = 500;
                            }
                        }
                    }
                    $response.status //= 204;
                    # Close push promises as we don't get a new ones
                    $response.close-push-promises();
                    $response
                }
            }

            method invoke(Cro::HTTP::Request $request, Capture $args) {
                if @!before-matched || @!after-matched {
                    my $current = supply emit $request;
                    my %connection-state{Mu};
                    $current = self!append-middleware($current, @!before-matched, %connection-state);
                    my $response = supply whenever $current -> $req {
                        whenever self!invoke-internal($req, $args) {
                            emit $_;
                        }
                    }
                    return self!append-middleware($response, @!after-matched, %connection-state);
                } else {
                    return self!invoke-internal($request, $args);
                }
            }
        }

        my class DelegateHandler does Handler {
            has Cro::Transform $.transform;
            has Bool $.wildcard;

            method copy-adding(:@prefix, :@body-parsers!, :@body-serializers!, :@before-matched!, :@after-matched!, :@around!) {
                self.bless:
                    :$!transform,
                    :prefix[flat @prefix, @!prefix],
                    :body-parsers[flat @!body-parsers, @body-parsers],
                    :body-serializers[flat @!body-serializers, @body-serializers],
                    before-matched => @before-matched.append(@!before-matched),
                    after-matched => @!after-matched.append(@after-matched),
                    around => @!around.append(@around)
            }

            method signature() {
                $!wildcard ?? (-> *@ { }).signature !! (-> {}).signature
            }

            method invoke(Cro::HTTP::Request $request, Capture $args) {
                my $req = $request.without-first-path-segments(@!prefix.elems);
                self!add-body-parsers($req);
                my $current = supply emit $req;
                my %connection-state{Mu};
                $current = self!append-middleware($current, @!before-matched, %connection-state);
                $current = $!transform.transformer($current);
                $current = self!append-body-serializers($current);
                $current = self!append-middleware($current, @!after-matched, %connection-state);
                $current
            }
        }

        has Handler @.handlers;
        has Cro::BodyParser @.body-parsers;
        has Cro::BodySerializer @.body-serializers;
        has @.includes;
        has @.before;
        has @.after;
        has @.before-matched;
        has @.after-matched;
        has @.around;
        has $!path-matcher;
        has @!handlers-to-add;  # Closures to defer adding, so they get all the middleware
        has Array %!plugin-config{Cro::HTTP::Router::PluginKey};

        method consumes() { Cro::HTTP::Request }
        method produces() { Cro::HTTP::Response }

        method transformer(Supply:D $requests) {
            supply {
                whenever $requests -> $request {
                    my $*CRO-ROUTER-REQUEST = $request;
                    my $*WRONG-METHOD = False;
                    my $*MISSING-UNPACK = False;
                    my @*BIND-FAILS;
                    my $log-timeline-task = $request.annotations<log-timeline>;
                    my $routing-outcome = Cro::HTTP::LogTimeline::Route.log: $log-timeline-task, -> {
                        $request.path ~~ $!path-matcher
                    }
                    with $routing-outcome {
                        my ($handler-idx, $args) = .ast;
                        my $handler := @!handlers[$handler-idx];
                        whenever $handler.invoke($request, $args) -> $response {
                            emit $response;
                            QUIT {
                                default {
                                    report-unhandled-error($_);
                                    emit Cro::HTTP::Response.new(:500status, :$request);
                                }
                            }
                        }
                    }
                    else {
                        my $status = 404;
                        if @*BIND-FAILS {
                            for @*BIND-FAILS -> $imp, \cap {
                                $imp(|cap);
                                CATCH {
                                    when X::TypeCheck::Binding::Parameter {
                                        my $param = .parameter;
                                        if $param.named {
                                            $status = 400;
                                            last;
                                        }
                                        elsif $param ~~ Auth || $param.type ~~ Cro::HTTP::Auth {
                                            $status = 401;
                                            last;
                                        }
                                    }
                                    default {}
                                }
                            }
                        }
                        elsif $*MISSING-UNPACK {
                            $status = 400;
                        }
                        elsif $*WRONG-METHOD {
                            $status = 405;
                        }
                        emit Cro::HTTP::Response.new(:$status, :$request);
                    }
                }
            }
        }

        method add-handler(Str $method, &implementation --> Nil) {
            @!handlers-to-add.push: {
                @!handlers.push(RouteHandler.new(:$method, :&implementation, :@!before-matched, :@!after-matched,
                        :@!around, :%!plugin-config));
            }
        }

        method add-body-parser(Cro::BodyParser $parser --> Nil) {
            @!body-parsers.push($parser);
        }

        method add-body-serializer(Cro::BodySerializer $serializer --> Nil) {
            @!body-serializers.push($serializer);
        }

        method add-include(@prefix, RouteSet $includee) {
            @!includes.push({ :@prefix, :$includee });
        }

        method add-before($middleware) {
            @!before.push($middleware);
        }
        method add-after($middleware) {
            @!after.push($middleware);
        }

        method add-before-matched($middleware) {
            @!before-matched.push($middleware);
        }
        method add-after-matched($middleware) {
            @!after-matched.push($middleware);
        }

        method add-around($cb) {
            @!around.push($cb);
        }

        method add-delegate(@prefix, Cro::Transform $transform) {
            my $wildcard = @prefix[*-1] eq '*';
            my @new-prefix = @prefix;
            @new-prefix.pop if $wildcard;
            @!handlers-to-add.push: {
                @!handlers.push: DelegateHandler.new:
                   prefix => @new-prefix,
                   :$transform, :$wildcard, :@!before-matched, :@!after-matched, :@!around;
           }
        }

        method add-plugin-config(Cro::HTTP::Router::PluginKey $key, Any $config --> Nil) {
            %!plugin-config{$key}.push($config);
        }

        method get-plugin-configs(Cro::HTTP::Router::PluginKey $key --> List) {
            (%!plugin-config{$key} // ()).List
        }

        method definition-complete(--> Nil) {
            while @!handlers-to-add.shift -> &add {
                add();
            }
            for @!handlers {
                .body-parsers = @!body-parsers;
                .body-serializers = @!body-serializers;
            }
            for @!includes -> (:@prefix, :$includee) {
                for $includee.handlers() {
                    @!handlers.push: .copy-adding(:@prefix, :@!body-parsers, :@!body-serializers,
                        :@!before-matched, :@!after-matched, :@!around, :%!plugin-config);
                }
            }
            self!generate-route-matcher();
        }

        method !generate-route-matcher(--> Nil) {
            my @route-matchers;
            my @handlers = @!handlers; # This is closed over in the EVAL'd regex
            for @handlers.kv -> Int $index, Handler $handler {
                push @route-matchers, compile-route($index, $handler);
            }
            use MONKEY-SEE-NO-EVAL;
            push @route-matchers, '<!>';
            $!path-matcher = EVAL 'regex { ^ ' ~
                ':my $req = $*CRO-ROUTER-REQUEST; ' ~
                ':my @segs = $req.path-segments; ' ~
                ':my $cap; ' ~
                '[ '  ~ @route-matchers.join(' | ') ~ ' ] ' ~
                '$ }';
        }

        sub compile-route(Int $index, Handler $handler) {
            # Things we need to do to prepare segments for binding and unpack
            # request data.
            my @checks;
            my @make-tasks;

            # If we need a signature bind test (due to subset/where).
            my $need-sig-bind = False;

            # The prefix is a set of segments that are part of the route
            # that we match, but excluded from the invocation capture that
            # we produce. These are used in include/delegate.
            my @prefix = $handler.prefix.map({ "'$_'" });
            my $prefix-elems = @prefix.elems;

            # Positionals are URL segments, nameds are unpacks of other
            # request data.
            my $signature = $handler.signature;
            my (:@positional, :@named) := $signature.params.classify:
                { .named ?? 'named' !! 'positional' };

            # If the first segment is an authorization constraint, extract
            # and it and compile the check.
            my $have-auth-param = False;
            with @positional[0] -> $param {
                if $param ~~ Auth || $param.type ~~ Cro::HTTP::Auth {
                    @positional.shift;
                    $have-auth-param = True;
                    $need-sig-bind = True;
                }
            }

            # Compile segments definition into a matcher.
            my @segments-required;
            my @segments-optional;
            my $segments-terminal = '';

            sub match-types($type,
                            :$lookup, :$target-name,
                            :$seg-index, :@matcher-target, :@constraints) {
                my constant @types = int8, int16, int32, int64, uint8, uint16, uint32, uint64;
                for @types {
                    if $type === $_ {
                        if $lookup {
                            pack-range($type.^nativesize, !$type.^unsigned,
                                       target => $lookup, :$target-name);
                        } else {
                            pack-range($type.^nativesize, !$type.^unsigned,
                                       :$seg-index, :@matcher-target, :@constraints);
                        }
                        return True;
                    }
                }
                False;
            }

            sub pack-range($bits, $signed,
                           :$target, :$target-name, # named
                           :$seg-index, :@matcher-target, :@constraints) {
                my $bound = 2 ** ($bits - 1);

                if $target.defined && $target-name.defined {
                    push @checks, '(with ' ~ $target ~ ' { ' ~
                                           ( if $signed {
                                                   -$bound ~ ' <= $_ <= ' ~ $bound - 1
                                               } else {
                                                 '0 <= $_ <= ' ~ 2 ** $bits - 1
                                             }
                                           )
                                           ~ '|| !($*MISSING-UNPACK = True)'
                                           ~ ' } else { True })';
                    # we coerce to Int here for two reasons:
                    # * Str cannot be coerced to native types;
                    # * We already did a range check;
                    @make-tasks.push: '%unpacks{Q[' ~ $target-name ~ ']} = .Int with ' ~ $target;
                } else {
                    my Str $range = $signed ?? -$bound ~ ' <= $_ <= ' ~ $bound - 1 !! '0 <= $_ <= ' ~ 2 ** $bits - 1;
                    my Str $check = '<?{('
                                  ~ Q:c/with @segs[{$prefix-elems + $seg-index}]/
                                  ~ ' {( '~ $range
                                  ~ ' )} else { True }) }>';
                    @matcher-target.push: Q['-'?\d+:] ~ $check;
                    @make-tasks.push: Q:c/.=Int with @segs[{$prefix-elems + $seg-index}]/;
                    $need-sig-bind = True if @constraints;
                }
            }

            for @positional.kv -> $seg-index, $param {
                my @constraints = extract-constraints($param);
                if $param.slurpy {
                    $segments-terminal = '{} .*:';
                    $need-sig-bind = True if @constraints;
                }
                else {
                    my @matcher-target := $param.optional
                        ?? @segments-optional
                        !! @segments-required;
                    my $type := $param.type;
                    if $type =:= Mu || $type =:= Any || $type =:= Str {
                        if @constraints == 1 && @constraints[0] ~~ Str:D {
                            # Literal string constraint; matches literally.
                            @matcher-target.push("'&encode(@constraints[0])'");
                        }
                        else {
                            # Any match will do, but need bind check.
                            @matcher-target.push('<-[/]>+:');
                            $need-sig-bind = True;
                        }
                    }
                    elsif $type =:= Int || $type =:= UInt {
                        @matcher-target.push(Q['-'?\d+:]);
                        my Str $coerce-prefix = $type =:= Int ?? '.=Int' !! '.=UInt';
                        @make-tasks.push: $coerce-prefix ~
                            Q:c/ with @segs[{$prefix-elems + $seg-index}]/;
                        $need-sig-bind = True if @constraints;
                    }
                    else {
                        my $matched = match-types($type, :$seg-index,
                                                  :@matcher-target, :@constraints);
                        die "Parameter type $type.^name() not allowed on a request unpack parameter" unless $matched;
                    }
                }
            }
            my $segment-matcher = " '/' " ~
                (flat @prefix, @segments-required).join(" '/' ") ~
                @segments-optional.map({ "[ '/' $_ " }).join ~ (' ]? ' x @segments-optional) ~
                $segments-terminal;

            # Turned nameds into unpacks.
            for @named -> $param {
                my $target-name = $param.named_names[0];
                my ($exists, $lookup) = do given $param {
                    when Cookie {
                        '$req.has-cookie(Q[' ~ $target-name ~ '])',
                        '$req.cookie-value(Q[' ~ $target-name ~ '])'
                    }
                    when Header {
                        '$req.has-header(Q[' ~ $target-name ~ '])',
                        '$req.header(Q[' ~ $target-name ~ '])'
                    }
                    default {
                        '$req.query-hash{Q[' ~ $target-name ~ ']}:exists',
                        '$req.query-value(Q[' ~ $target-name ~ '])'
                    }
                }
                unless $param.optional {
                    push @checks, '(' ~ $exists ~ ' || !($*MISSING-UNPACK = True))';
                }

                my $type := $param.type;
                if $type =:= Mu || $type =:= Any || $type =:= Str {
                    push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = $_ with ' ~ $lookup;
                }
                elsif $type =:= Int || $type =:= UInt {
                    push @checks, '(with ' ~ $lookup ~ ' { so /^"-"?\d+$/ } else { True })';
                    push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = ' ~
                                                    ($type =:= Int ?? '.Int' !! '.UInt')
                                                    ~ ' with ' ~ $lookup;
                }
                elsif $type =:= Positional {
                    given $param {
                        when Header {
                            push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = $req.headers';
                        }
                        when Cookie {
                            die "Cookies cannot be extracted to List. Maybe you want '%' instead of '@'";
                        }
                        default {
                            push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = $req.query-list';
                        }
                    }
                }
                elsif $type =:= Associative {
                    given $param {
                        when Cookie {
                            push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = $req.cookie-hash';
                        }
                        when Header {
                            push @make-tasks,
                            'my %result;'
                                ~ '$req.headers.map({ %result{$_.name} = $_.value });'
                                ~ '%unpacks{Q['
                                ~ $target-name
                                ~ ']} = %result;';
                        }
                        default {
                            push @make-tasks, '%unpacks{Q[' ~ $target-name ~ ']} = $req.query-hash'
                        }
                    }
                }
                else {
                    my $matched = match-types($type, :$lookup, :$target-name);
                    die "Parameter type $type.^name() not allowed on a request unpack parameter" unless $matched;
                }
                $need-sig-bind = True if extract-constraints($param);
            }

            my $method-check = $handler.can('method')
                ?? '<?{ $req.method eq "' ~ $handler.method ~
                    '" || !($*WRONG-METHOD = True) }>'
                !! '';
            my $checks = @checks
                ?? '<?{ ' ~ @checks.join(' and ') ~ ' }>'
                !! '';
            my $form-cap = '{ my %unpacks; ' ~ @make-tasks.join(';') ~
                '; $cap = Capture.new(:list(' ~
                ($have-auth-param
                    ?? '$req.auth' ~ (@positional ?? ', |' !! ',')
                    !! '') ~
                (@positional == 0
                    ?? ''
                    !! '@segs' ~ ($prefix-elems ?? "[$prefix-elems..*]" !! "")) ~
                '), :hash(%unpacks)); }';
            my $bind-check = $need-sig-bind
                ?? '<?{ my $han = @handlers[' ~ $index ~ ']; ' ~
                        '$han.signature.ACCEPTS($cap) || ' ~
                        '!(@*BIND-FAILS.push($han.implementation, $cap)) }>'
                !! '';
            my $make = '{ make (' ~ $index ~ ', $cap) }';
            return join " ",
                $segment-matcher, $method-check, $checks, $form-cap,
                $bind-check, $make;
        }

        sub encode($target) {
            $target.subst: :g, /<-[A..Za..z0..9_~.-]>/, -> Str() $encodee {
                $encodee eq ' '
                    ?? '+'
                    !! $encodee le "\x7F"
                        ?? '%' ~ $encodee.ord.base(16)
                        !! $encodee.encode('utf-8').list.map({ '%' ~ .base(16) }).join
            }
        }

        sub extract-constraints(Parameter:D $param) {
            my @constraints;
            sub extract($v --> Nil) { @constraints.push($v) }
            extract($param.constraints);
            return @constraints;
        }

        method sink() is hidden-from-backtrace {
            warn "Useless use of a Cro `route` block in sink context. Did you forget to `include` or `delegate`?";
        }
    }

    #| Define a set of routes. Expects to receive a block, which will be evaluated
    #| to set up the routing definition.
    sub route(&route-definition) is export {
        my $*CRO-ROUTE-SET = RouteSet.new;
        route-definition();
        $*CRO-ROUTE-SET.definition-complete();
        my @before = $*CRO-ROUTE-SET.before;
        my @after = $*CRO-ROUTE-SET.after;
        if @before || @after {
            return Cro.compose(|@before, $*CRO-ROUTE-SET, |@after, :for-connection);
        } else {
            $*CRO-ROUTE-SET;
        }
    }

    #| Add a handler for a HTTP GET request. The signature of the handler will be
    #| used to determine the routing.
    multi get(&handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler('GET', &handler);
    }

    #| Add a handler for a HTTP POST request. The signature of the handler will be
    #| used to determine the routing.
    multi post(&handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler('POST', &handler);
    }

    #| Add a handler for a HTTP PUT request. The signature of the handler will be
    #| used to determine the routing.
    multi put(&handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler('PUT', &handler);
    }

    #| Add a handler for a HTTP DELETE request. The signature of the handler will be
    #| used to determine the routing.
    multi delete(&handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler('DELETE', &handler);
    }

    #| Add a handler for a HTTP PATCH request. The signature of the handler will be
    #| used to determine the routing.
    multi patch(&handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler('PATCH', &handler);
    }

    #| Add a body parser, which will be considered for use when parsing the body of
    #| a request to a route within this route block.
    sub body-parser(Cro::BodyParser $parser --> Nil) is export {
        $*CRO-ROUTE-SET.add-body-parser($parser);
    }

    #| Add a body serializer, which will be considered for use when serializing the body of
    #| a response produced by a handler within this route block.
    sub body-serializer(Cro::BodySerializer $serializer --> Nil) is export {
        $*CRO-ROUTE-SET.add-body-serializer($serializer);
    }

    #| Flatten the routes of another route block into this one, optionally adding a
    #| prefix. The prefix may be specified by passing Pairs or named argument.
    sub include(*@includees, *%includees --> Nil) is export {
        for @includees {
            when RouteSet  {
                $*CRO-ROUTE-SET.add-include([], $_);
            }
            when Pair {
                my ($prefix, $routes) = .kv;
                if $routes ~~ RouteSet {
                    given $prefix {
                        when Str {
                            $*CRO-ROUTE-SET.add-include([$prefix], $routes);
                        }
                        when Iterable {
                            $*CRO-ROUTE-SET.add-include($prefix, $routes);
                        }
                        default {
                            die "An 'include' prefix may be a Str or Iterable, but not " ~ .^name;
                        }
                    }
                }
                else {
                    die "Can only use 'include' with 'route' block, not a $routes.^name()";
                }
            }
            when Cro::CompositeTransform::WithConnectionState {
                die "Cannot 'include' `route` block that contains before or after middleware, try delegate instead";
            }
            default {
                die "Can only use 'include' with `route` block, not a " ~ .^name;
            }
        }
        for %includees.kv -> $prefix, $routes {
            if $routes ~~ RouteSet {
                $*CRO-ROUTE-SET.add-include([$prefix], $routes);
            }
            else {
                die "Can only use 'include' with `route` block, not a $routes.^name()";
            }
        }
    }

    #| Delegate a path to some other Cro::Transform, which must consume a HTTP
    #| request and produce a HTTP response. The mappings of paths to transforms
    #| are expressed by passing Pairs or named arguments.
    sub delegate(*@delegates, *%delegates --> Nil) is export {
        for flat @delegates, %delegates.pairs {
            when Pair {
                my ($prefix, $transform) = .kv;
                unless $transform ~~ Cro::Transform {
                    die "Pairs passed to 'delegate' must have a Cro::Transform value";
                }
                unless $transform.consumes ~~ Cro::HTTP::Request {
                    die "Transform used with delegate must consume Cro::HTTP::Request, but " ~
                        $transform.^name ~ " consumes " ~ $transform.consumes.^name;
                }
                unless $transform.produces ~~ Cro::HTTP::Response {
                    die "Transform used with delegate must produce Cro::HTTP::Response, but " ~
                        $transform.^name ~ " produces " ~ $transform.produces.^name;
                }
                given $prefix {
                    when Iterable {
                        $*CRO-ROUTE-SET.add-delegate($prefix, $transform);
                    }
                    when Str {
                        $*CRO-ROUTE-SET.add-delegate([$prefix], $transform);
                    }
                    default {
                        die "Pairs passed to 'delegate' must have a Str or Iterable key, not " ~ .^name;
                    }
                }
            }
            default {
                die "Must pass one or more Pairs to 'delegate', not a " ~ .^name;
            }
        }
    }

    #| Access the Cro::HTTP::Request object for the current request
    sub term:<request>() is export {
        $*CRO-ROUTER-REQUEST //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<request>)
    }

    #| Access the Cro::HTTP::Response object for the response currently
    #| being produced
    sub term:<response>() is export {
        $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<response>)
    }

    #| Await the request body, obtaining it as a Blob, and then pass it to the
    #| first matching handler. If the handler is a Pair, then the key will be taken as a
    #| content type, and the handler, specified as the value of the Pair, will only
    #| be invoked if the content type matches that of the request. Otherwise, the
    #| handler should be a block.
    sub request-body-blob(**@handlers) is export {
        run-body-handler(@handlers, await request.body-blob)
    }

    #| Await the request body, obtaining it as a Str, and then pass it to the
    #| first matching handler. If the handler is a Pair, then the key will be taken as a
    #| content type, and the handler, specified as the value of the Pair, will only
    #| be invoked if the content type matches that of the request. Otherwise, the
    #| handler should be a block.
    sub request-body-text(**@handlers) is export {
        run-body-handler(@handlers, await request.body-text)
    }

    #| Await the request body, which will have been parsed using a body parser.
    #| and then dispatch it to the the first matching handler passed to this
    #| function. If the handler is a Pair, then the key will be taken as a
    #| content type, and the handler, specified as the value of the Pair, will only
    #| be invoked if the content type matches that of the request. Otherwise, the
    #| handler should be a block. In any case, the block will be invoked only if the
    #| signature accepts the request body (thus, destructuring may be used in order
    #| to validate the request body). If no handler matches, a 400 Bad Request
    #| response will be produced automatically; to override this, pass a block that
    #| accepts any object.
    sub request-body(**@handlers) is export {
        run-body-handler(@handlers, await request.body)
    }

    sub run-body-handler(@handlers, \body) {
        for @handlers -> $handler {
            when $handler ~~ Block {
                CATCH {
                    when X::Cannot::