### ----------------------------------------------------
### -- Cro::HTTP
### -- Licenses: Artistic-2.0
### -- Authors: Jonathan Worthington <jnthn@jnthn.net>
### -- File: lib/Cro/HTTP/Router.rakumod
### ----------------------------------------------------
### -- Chunk 2 of 2
Capture {
                        die X::Cro::HTTP::Router::ConfusedCapture.new(
                            :body(body),
                            :content-type(request.content-type),
                            :signature($handler.signature)) if @handlers.elems == 1;
                    }
                }
                return $handler.(body) if $handler.signature.ACCEPTS(\(body));
            }
            when $handler ~~ Pair {
                with request.content-type -> $content-type {
                    if $handler.key eq $content-type.type-and-subtype {
                        CATCH {
                            when X::Cannot::Capture {
                                die X::Cro::HTTP::Router::ConfusedCapture.new(
                                    :body(body),
                                    :$content-type,
                                    :signature($handler.value.signature));
                            }
                        }
                        return $handler.value()(body) if $handler.value.signature.ACCEPTS(\(body));
                    }
                }
            }
            default {
                die "request-body handlers can only be a Block or a Pair, not a $handler.^name()";
            }
        }
        die X::Cro::HTTP::Router::NoRequestBodyMatch.new;
    }

    proto header(|) is export {*}

    #| Add a header to the HTTP response produced by this handler
    multi header(Cro::HTTP::Header $header --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<header>);
        $resp.append-header($header);
    }

    #| Add a header to the HTTP response produced by this handler; the string
    #| passed must parse as a valid header
    multi header(Str $header --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<header>);
        $resp.append-header($header);
    }

    #| Add a header to the HTTP response produced by this handler
    multi header(Str $name, Str(Cool) $value --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<header>);
        $resp.append-header($name, $value);
    }

    proto content(|) is export {*}

    #| Specify content to be sent as a response, passing a content type and the
    #| body. The body will be serialized using a body serializer. If no request
    #| status was set, it will be set to 200 OK.
    multi content(Str $content-type, $body, :$enc = $body ~~ Str ?? 'utf-8' !! Nil --> Nil) {
        my Cro::HTTP::Response $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<content>);
        $resp.status //= 200;
        $resp.remove-header('content-type'); # Multiple content-type headers make no sense
        with $enc {
            $resp.append-header('Content-type', qq[$content-type; charset=$_]);
        }
        else {
            $resp.append-header('Content-type', $content-type);
        }
        $resp.set-body($body);
    }

    proto created(|) is export {*}

    #| Produced a HTTP 201 Created response, setting the Location header with
    #| the provided path (specifying a Location is required when producing a
    #| HTTP 201 response)
    multi created(Str() $location --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<created>);
        $resp.status = 201;
        $resp.append-header('Location', $location);
    }

    #| Produced a HTTP 201 Created response, setting the Location header with
    #| the provided path (specifying a Location is required when producing a
    #| HTTP 201 response). The remaining arguments will be passed to the content
    #| function, setting the media type, response body, and other options.
    multi created(Str() $location, $content-type, $body, *%options --> Nil) {
        created $location;
        content $content-type, $body, |%options;
    }

    proto redirect(|) is export {*}

    #| Produce a HTTP redirect response, defaulting to a temporary redirect (HTTP 307).
    #| The location is the address to redirect to.
    multi redirect(Str() $location, :$temporary, :$permanent, :$see-other --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<redirected>);
        if $permanent {
            $resp.status = 308;
        }
        elsif $see-other {
            $resp.status = 303;
        }
        else {
            $resp.status = 307;
        }
        $resp.append-header('Location', $location);
    }

    #| Produce a HTTP redirect response, defaulting to a temporary redirect (HTTP 307).
    #| The location is the address to redirect to. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi redirect(Str() $location, $content-type, $body, :$temporary,
                   :$permanent, :$see-other, *%options --> Nil) {
        redirect $location, :$permanent, :$see-other;
        content $content-type, $body, |%options;
    }

    proto not-found(|) is export {*}

    #| Produce a HTTP 404 Not Found response
    multi not-found(--> Nil) {
        set-status(404, :action<not-found>);
    }

    #| Produce a HTTP 404 Not Found response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi not-found($content-type, $body, *%options --> Nil) {
        set-status(404, :action<not-found>);
        content $content-type, $body, |%options;
    }

    proto bad-request(|) is export {*}

    #| Produce a HTTP 400 Bad Request response
    multi bad-request(--> Nil) {
        set-status(400, :action<bad-request>);
    }

    #| Produce a HTTP 400 Bad Request response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi bad-request($content-type, $body, *%options --> Nil) {
        set-status(400, :action<bad-request>);
        content $content-type, $body, |%options;
    }

    proto forbidden(|) is export {*}

    #| Produce a HTTP 403 Forbidden response
    multi forbidden(--> Nil) {
        set-status(403, :action<forbidden>);
    }

    #| Produce a HTTP 403 Forbidden response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi forbidden($content-type, $body, *%options --> Nil) {
        set-status(403, :action<forbidden>);
        content $content-type, $body, |%options;
    }

    proto conflict(|) is export {*}

    #| Produce a HTTP 409 Conflict response
    multi conflict(--> Nil) {
        set-status(409, :action<conflict>);
    }

    #| Produce a HTTP 409 Conflict response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi conflict($content-type, $body, *%options --> Nil) {
        set-status(409, :action<conflict>);
        content $content-type, $body, |%options;
    }

    proto i'm-a-teapot(|) is export {*}

    multi i'm-a-teapot(--> Nil) {
        set-status(418, :action<i'm-a-teapot>);
    }

    multi i'm-a-teapot($content-type, $body, *%options --> Nil) {
        set-status(418, :action<i'm-a-teapot>);
        content $content-type, $body, |%options;
    }

    proto server-error(|) is export {*}

    #| Produce a HTTP 500 Server Error response
    multi server-error(--> Nil) {
        set-status(500, :action<server-errror>);
    }

    #| Produce a HTTP 500 Server Error response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi server-error($content-type, $body, *%options --> Nil) {
        set-status(500, :action<server-error>);
        content $content-type, $body, |%options;
    }

    proto not-supported(|) is export {*}

    #| Produce a HTTP 505 Not Supported response
    multi not-supported(--> Nil) {
        set-status(505, :action<not-supported>);
    }

    #| Produce a HTTP 505 Not Supported response. The remaining arguments will be
    #| passed to the content function, setting the media type, response body, and
    #| other options.
    multi not-supported($content-type, $body, *%options --> Nil) {
        set-status(505, :action<not-supported>);
        content $content-type, $body, |%options;
    }

    #| Add a cookie to the response
    sub set-cookie($name, $value, *%opts) is export {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<route>);
        $resp.set-cookie($name, $value, |%opts);
    }

    sub set-status(Int $status, Str :$action = 'set-status' --> Nil) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what($action));
        $resp.status = $status;
    }

    #| Add a push promise, specifying the path and headers. The headers may be
    #| specified as a list of Pairs or Cro::HTTP::Header objects.
    sub push-promise(Str $path, :$headers) is export {
        with $headers {
            if $headers ~~ Hash {
                push-promise-internal($path, $headers.List)
            } elsif $headers ~~ List {
                push-promise-internal($path, $headers)
            } else {
                die "push-promise headers argument must be a Hash or a List, got {$headers.^name} instead";
            }
        }
        else {
            push-promise-internal($path, []);
        }
    }
    sub push-promise-internal(Str $path, @headers) {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<push-promise>);
        # TODO: We don't set http-version anywhere really, so check a request instead.
        # To fix we need to introduce some rules to set appropriate http version
        # during $*CRO-ROUTER-RESPONSE creation.
        return unless ($*CRO-ROUTER-REQUEST.http-version // '') eq '2.0';
        $resp.http-version = '2.0';
        # TODO: target resolution
        my $pp = Cro::HTTP::PushPromise.new(:method<GET>,
                                            target => $path);
        $pp.append-header($_) for @headers;
        $resp.add-push-promise($pp);
    }

    my class BeforeMiddleTransform does Cro::HTTP::Middleware::Conditional {
        has &.block;
        has $.route-set;

        method process(Supply $pipeline --> Supply) {
            supply {
                whenever $pipeline -> $request {
                    my $*CRO-ROUTER-REQUEST := $request;
                    my $*CRO-ROUTER-RESPONSE := Cro::HTTP::Response.new(:$request);
                    my $*CRO-MIDDLEWARE-ROUTE-SET = $!route-set;
                    &!block($request);
                    emit $*CRO-ROUTER-RESPONSE.status.defined
                        ?? $*CRO-ROUTER-RESPONSE
                        !! $request;
                }
            }
        }
    }

    my class AfterMiddleTransform does Cro::Transform {
        has &.block;
        has $.route-set;

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

        method transformer(Supply $pipeline --> Supply) {
            supply {
                whenever $pipeline -> $response {
                    my $*CRO-ROUTER-RESPONSE := $response;
                    my $*CRO-MIDDLEWARE-ROUTE-SET = $!route-set;
                    &!block($response);
                    emit $response;
                }
            }
        }
    }

    #| Add request middleware, which will take place prior to any routing taking
    #| place
    multi sub before(Cro::Transform $middleware --> Nil) is export {
        $_ = $middleware;
        if .consumes ~~ Cro::HTTP::Request
        && .produces ~~ Cro::HTTP::Request {
            $*CRO-ROUTE-SET.add-before($_)
        } else {
            die "before middleware must consume and produce Cro::HTTP::Request, got ({.consumes.perl}) and ({.produces.perl}) instead";
        }
    }

    #| Run the specified block before any routing takes place. If it produces, a
    #| response by itself, then no routing will be performed.
    multi sub before(&middleware --> Nil) is export {
        my $conditional = BeforeMiddleTransform.new(block => &middleware, route-set => $*CRO-ROUTE-SET);
        $*CRO-ROUTE-SET.add-before($conditional.request);
        $*CRO-ROUTE-SET.add-after($conditional.response);
    }

    #| Add request/response middleware specified as single object pairing the
    #| two together
    multi sub before(Cro::HTTP::Middleware::Pair $pair --> Nil) {
        before($pair.request);
        after($pair.response);
    }

    #| Add response middleware, which will take place after the router, and
    #| regardless of any route being matched (so if no route matched, this
    #| would get the 404 response to process)
    multi sub after(Cro::Transform $middleware --> Nil) is export {
        $_ = $middleware;
        if .consumes ~~ Cro::HTTP::Response
        && .produces ~~ Cro::HTTP::Response {
            $*CRO-ROUTE-SET.add-after($_)
        } else {
            die "after middleware must consume and produce Cro::HTTP::Response, got ({.consumes.perl}) and ({.produces.perl}) instead";
        }
    }

    #| Run the specified block after all route processing is done, and
    #| regardless of any route being matched (so if no route matched, this
    #| would get the 404 response to process).
    multi sub after(&middleware --> Nil) is export {
        my $transformer = AfterMiddleTransform.new(block => &middleware, route-set => $*CRO-ROUTE-SET);
        $*CRO-ROUTE-SET.add-after($transformer);
    }

    #| Run the specified request middleware after a route has been matched, but
    #| before running the route handler
    multi sub before-matched(Cro::Transform $middleware --> Nil) is export {
        $_ = $middleware;
        if .consumes ~~ Cro::HTTP::Request
        && .produces ~~ Cro::HTTP::Request {
            $*CRO-ROUTE-SET.add-before-matched($_)
        } else {
            die "before-matched middleware must consume and produce Cro::HTTP::Request, got ({.consumes.perl}) and ({.produces.perl}) instead";
        }
    }

    #| Run the specified block after a route has been matched, but
    #| before running the route handler; if the block produces a response,
    #| then the route handler will not be run
    multi sub before-matched(&middleware --> Nil) is export {
        my $conditional = BeforeMiddleTransform.new(block => &middleware);
        $*CRO-ROUTE-SET.add-before-matched($conditional.request);
        $*CRO-ROUTE-SET.add-after-matched($conditional.response);
    }

    #| Add request/response middleware specified as single object pairing the
    #| two together; they will only be executed if a route is matched by the
    #| request
    multi sub before-matched(Cro::HTTP::Middleware::Pair $pair --> Nil) {
        before-matched($pair.request);
        after-matched($pair.response);
    }

    #| Run the specified request middleware after a route has been matched and its
    #| route handler has finished executing; if no route handler is matched, then
    #| the middleware will not be run
    multi sub after-matched(Cro::Transform $middleware --> Nil) is export {
        $_ = $middleware;
        if .consumes ~~ Cro::HTTP::Response
        && .produces ~~ Cro::HTTP::Response {
            $*CRO-ROUTE-SET.add-after-matched($_)
        } else {
            die "after-matched middleware must consume and produce Cro::HTTP::Response, got ({.consumes.perl}) and ({.produces.perl}) instead";
        }
    }

    #| Run the specified block after a route has been matched and its route
    #| handler has finished executing; if no route handler is matched, then
    #| the block will not run
    multi sub after-matched(&middleware --> Nil) is export {
        my $transformer = AfterMiddleTransform.new(block => &middleware);
        $*CRO-ROUTE-SET.add-after-matched($transformer);
    }

    sub around(&cb --> Nil) is export {
        $*CRO-ROUTE-SET.add-around(&cb);
    }

    #| Add a request handler for the specified HTTP method. This is useful
    #| when there is no shortcut function available for the HTTP method.
    sub http($method, &handler --> Nil) is export {
        $*CRO-ROUTE-SET.add-handler($method, &handler);
    }

    #| Set a cache control header on the response according to the provided
    #| options. Any existing Cache-control header will be removed before the
    #| new one is added.
    sub cache-control(:$public, :$private, :$no-cache, :$no-store,
                      Int :$max-age, Int :$s-maxage,
                      :$must-revalidate, :$proxy-revalidate,
                      :$no-transform) is export {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<route>);
        die if ($public, $private, $no-cache).grep(Bool).elems != 1;
        $resp.remove-header('Cache-Control');
        my @headers = (:$public, :$private, :$no-cache, :$no-store,
                       :$max-age, :$s-maxage,
                       :$must-revalidate, :$proxy-revalidate,
                       :$no-transform);
        my $cache = @headers.map(
            {
                if .key eq 'max-age'|'s-maxage' { "{.key}={.value}" if .value }
                else { "{.key}" if .value }
            }).join(', ');
        $resp.append-header('Cache-Control', $cache);
    }

    sub get-mime-or-default($ext, %fallback, :$default = 'application/octet-stream') {
        %mime{$ext} // %fallback{$ext} // $default;
    }

    #| Serve static content from a file. With a single argument, that file is
    #| served. Otherwise, the first argument specifies a base path, and the
    #| remaining positional arguments are treated as path segments. However,
    #| it is not possible to reach a path above the base.
    sub static(IO() $base, *@path, :$mime-types, :@indexes) is export {
        my $resp = $*CRO-ROUTER-RESPONSE //
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what<route>);

        my $child = '.';
        for @path {
            $child = $child.IO.add: $_;
        }
        my %fallback = $mime-types // {};

        my sub get_or_404($path) {
            if $path.e {
                if $path.d {
                    for @indexes {
                        my $index = $path.add($_);
                        if $index.e {
                            content get-mime-or-default($index.extension, %fallback), slurp($index, :bin);
                            return;
                        }
                    }
                    $resp.status = 404;
                    return;
                } else {
                    content get-mime-or-default($path.extension, %fallback), slurp($path, :bin);
                }
            } else {
                $resp.status = 404;
            }
        }

        if $child eq '.' {
            get_or_404($base);
        } else {
            with $base.&child-secure: $child {
                get_or_404($_);
            } else {
                $resp.status = 403;
            }
        }
    }

    #| Register a router plugin. The provided ID is for debugging purposes.
    #| Returns a plugin key object which can be used for further interactions
    #| with the router plugin infrastructure.
    sub router-plugin-register(Str $id --> Cro::HTTP::Router::PluginKey) is export(:plugin) {
        Cro::HTTP::Router::PluginKey.new(:$id)
    }

    #| Adds an item of configuration to the current `route` block for the
    #| specified key. This will typically be called by a `sub` implementing
    #| the router plugin, and attaches configuration for the specified key
    #| to the object representing the current `route` block. The optional
    #| C<error-sub> named argument can be used to provide the name of the
    #| DSL sub called for reporting purposes; it will default to the plugin
    #| key ID.
    sub router-plugin-add-config(Cro::HTTP::Router::PluginKey $key, $config, Str :$error-sub = $key.id) is export(:plugin) {
        with $*CRO-ROUTE-SET {
            .add-plugin-config($key, $config);
        }
        else {
            die X::Cro::HTTP::Router::OnlyInRouteBlock.new(:what($error-sub));
        }
    }

    #| Get the plugin configuration added for the current route block. This may be
    #| called both during route setup time and inside of a route handler processing
    #| a request.
    sub router-plugin-get-innermost-configs(Cro::HTTP::Router::PluginKey $key, Str :$error-sub = $key.id --> List) is export(:plugin) {
        with $*CRO-ROUTER-ROUTE-HANDLER {
            .get-innermost-plugin-configs($key)
        }
        orwith $*CRO-ROUTE-SET {
            .get-plugin-configs($key)
        }
        else {
            die X::Cro::HTTP::Router::OnlyInRouteBlock.new(:what($error-sub));
        }
    }

    #| Get the configuration data added for the current route block as well as those
    #| has been included into. This can only be called in a request handler or a
    #| before/after middleware block.
    sub router-plugin-get-configs(Cro::HTTP::Router::PluginKey $key, Str :$error-sub = $key.id --> List) is export(:plugin) {
        with $*CRO-ROUTER-ROUTE-HANDLER {
            .get-plugin-configs($key)
        }
        orwith $*CRO-MIDDLEWARE-ROUTE-SET {
            .get-plugin-configs($key)
        }
        else {
            die X::Cro::HTTP::Router::OnlyInHandler.new(:what($error-sub));
        }
    }

    my $resources-plugin = router-plugin-register('resource');

    #| Specify the resources hash that calls to the C<resource> sub will use.
    #| Typically this will be called as C<use-resources %?RESOURCES;>.
    sub resources-from(%resources --> Nil) is export {
        router-plugin-add-config($resources-plugin, %resources, error-sub => 'use-resources');
    }

    #| Provide the response from a resource. Before using this, the C<resources-from>
    #| sub should be used in the C<route> block in order to associate the correct
    #| resources hash with the routes. The path parts will be joined with `/`s, and
    #| a lookup done in the resources hash.
    sub resource(*@path, :$mime-types, :@indexes --> Nil) is export {
        # Make sure that we have some resource hash associated with the route block.
        my @resource-hashes := router-plugin-get-configs($resources-plugin);
        unless @resource-hashes {
            die "No resources have been associated with the route block; please add `resources-from %?RESOURCES`";
        }

        # Look through the resource hashes.
        my $path = @path.grep(*.so).join: '/';
        my %fallback = $mime-types // {};
        for @resource-hashes {
            # First for the path.
            with .{$path} -> $resource {
                my $io = $resource.IO;
                if $io !~~ Slip && $io.e && $io.f {
                    content get-mime-or-default(get-extension($path), %fallback), $resource.slurp(:bin);
                    return;
                }
            }

            # Failing that, we may want an index file.
            for @indexes -> $index {
                my $index-path = $path ?? "$path/$index" !! $index;
                with .{$index-path} -> $resource {
                    my $io = $resource.IO;
                    if $io !~~ Slip && $io.e && $io.f {
                        content get-mime-or-default(get-extension($index-path), %fallback), $resource.slurp(:bin);
                        return;
                    }
                }
            }
        }

        not-found;
    }

    sub get-basename(Str $path --> Str) {
        with $path.rindex('/') { $path.substr($_ + 1) } else { $path }
    }

    sub get-extension(Str $path --> Str) {
        my $basename = get-basename($path);
        with $basename.rindex('.') { $basename.substr($_ + 1) } else { '' }
    }

    #| Resolve a resource in the resources associated with the enclosing route block or the current
    #| route handler. Exposed for the sake of other plugins that wish to access resources also.
    sub resolve-route-resource(Str $path, Str :$error-sub = 'resolve-resource' --> IO) is export(:resource-plugin) {
        route-resource-resolver(:$error-sub)($path)
    }

    #| Get a resolver that, when invoked with a path, will try to resolve it in
    #| the resource hashes registered with the route blocks currently in scope.
    #| (This is especially useful when one wishes to resolve resources as they
    #| would be in the route block, but in a different dynamic scope.)
    sub route-resource-resolver(Str :$error-sub = 'route-resource-resolver' --> Code) is export(:resource-plugin) {
        my @resource-hashes := router-plugin-get-configs($resources-plugin, :$error-sub);
        sub (Str $path) {
            for @resource-hashes {
                my $io = .{$path}.IO;
                if $io !~~ Slip && $io.e && $io.f {
                    return $io;
                }
            }
            Nil
        }
    }
}


