use HTTP::Message;
use URI;
use URI::Escape;
use HTTP::MediaType;
use MIME::Base64;

unit class HTTP::Request is HTTP::Message;

subset RequestMethod of Str where any(<GET POST HEAD PUT DELETE PATCH>);

has RequestMethod $.method is rw;
has $.url is rw;
has $.file is rw;
has $.uri is rw;

has Str $.host is rw;
has Int $.port is rw;
has Str $.scheme is rw;

my $CRLF = "\r\n";

my $HRC_DEBUG = %*ENV<HRC_DEBUG>.Bool;

proto method new(|c) { * }

multi method new(Bool :$bin, *%args) {

    if %args.keys.elems >= 1 {
        my ($method, $url, $file, %fields, $uri);
        for %args.kv -> $key, $value {
            if $key.lc ~~ any(<get post head put delete patch>) {
                $uri = $value.isa(URI) ?? $value !! URI.new($value);
                $method = $key.uc;
            } else {
                %fields{$key} = $value;
            }
        }

        my $header = HTTP::Header.new(|%fields);

        $method //= 'GET';

        self.new($method, $uri, $header, :$bin);
    }
    else {
        self.bless;
    }
}

multi method new(*@a where *.elems == 0 ) {
    self.bless;
}

multi method new(RequestMethod $method, URI $uri, HTTP::Header $header, Bool :$bin) {
    my $url = $uri.grammar.parse_result.orig;
    my $file = $uri.path_query || '/';

    if not $header.field('Host').defined {
        $header.field(Host => get-host-value($uri));
    }

    self.bless(:$method, :$url, :$header, :$file, :$uri, binary => $bin);
}



sub get-host-value(URI $uri --> Str) {
    my Str $host = $uri.host;

    if $host {
        if ( $uri.port != $uri.default_port ) {
            $host ~= ':' ~ $uri.port;
        }
    }
    $host;
}

method set-method($method) { $.method = $method.uc }

proto method uri(|c) { * }

multi method uri($uri is copy where URI|Str) {
    $!uri = $uri.isa(Str) ?? URI.new($uri) !! $uri ;
    $!url = $!uri.grammar.parse_result.orig;
    $!file = $!uri.path_query || '/';
    self.field(Host => get-host-value($!uri));
    $!uri;
}

multi method uri() is rw {
    $!uri;
}

proto method host(|c) { * }

multi method host() returns Str is rw {
    if not $!host.defined {
         $!host = ~self.field('Host').values;
    }
    $!host;
}

proto method port(|c) { * }

multi method port() returns Int is rw {
    if not $!port.defined {
        # if there isn't a scheme the no default port
        if try self.uri.scheme {
            $!port = self.uri.port;
        }
    }
    $!port;
}

proto method scheme(|c) { * }

multi method scheme() returns Str is rw {
    if not $!scheme.defined {
        $!scheme = self.uri.scheme;

        CATCH {
            default {
                $!scheme = 'http';
            }
        }
    }
    $!scheme
}

method add-cookies($cookies) {
    if $cookies.cookies.elems {
        $cookies.add-cookie-header(self);
    }
}

proto method add-content(|c) { * }

multi method add-content(Str $content) {
    self.content ~= $content;
    self.header.field(Content-Length => self.content.encode.bytes.Str);

}

proto method add-form-data(|c) { * }

multi method add-form-data(:$multipart, *%data) {
    self.add-form-data(%data.sort.Array, :$multipart);
}

multi method add-form-data(%data, :$multipart) {
    self.add-form-data(%data.sort.Array, :$multipart);
}

multi method add-form-data(Array $data, :$multipart) {
    my $ct = do {
        my $f = self.header.field('Content-Type');
        if $f {
            $f.values[0];
        } else {
            if $multipart {
                'multipart/form-data';
            }
            else {
                'application/x-www-form-urlencoded';
            }
        }
    };
    sub form-escape($s) {
        uri-escape($s).subst(:g, '%20', '+').subst(:g, '%2A', '*');
    }
    given $ct {
        when 'application/x-www-form-urlencoded' {
            my @parts;
            for @$data {
                @parts.push: form-escape(.key) ~ "=" ~ form-escape(.value);
            }
            self.content = @parts.join("&").encode;
            self.header.field(Content-Length => self.content.bytes.Str);

        }
        when m:i,^ "multipart/form-data" \s* ( ";" | $ ), {
            say 'generating form-data' if $HRC_DEBUG;

            my $mt = HTTP::MediaType.parse($ct);
            my Str $boundary = $mt.param('boundary') // self.make-boundary(10);
            (my $generated-content, $boundary) = self.form-data($data, $boundary);
            $mt.param('boundary', $boundary);
            $ct = $mt.Str;
            my Str $encoded-content = $generated-content;
            self.content = $encoded-content;
            self.header.field(Content-Length => $encoded-content.encode('ascii').bytes.Str);
        }
    }
    self.header.field(Content-Type => $ct);
}


method form-data(Array $content, Str $boundary) {
    my @parts;
    for @$content {
        my ($k, $v) = $_.key, $_.value;
        given $v {
            when Str {
                $k ~~ s:g/(<[\\ \"]>)/\\$1/;  # escape quotes and backslashes
                @parts.push: qq!Content-Disposition: form-data; name="$k"$CRLF$CRLF$v!;
            }
            when Array {
                my ($file, $usename, @headers) = @$v;
                unless defined $usename {
                    $usename = $file;
                    $usename ~~ s!.* "/"!! if defined($usename);
                }
                $k ~~ s:g/(<[\\ \"]>)/\\$1/;
                my $disp = qq!form-data; name="$k"!;
                if (defined($usename) and $usename.elems > 0) {
                    $usename ~~ s:g/(<[\\ \"]>)/\\$1/;
                    $disp ~= qq!; filename="$usename"!;
                }
                my $content;
                my $headers = HTTP::Header.new(|@headers);
                if ($file) {
                    # TODO: dynamic file upload support
                    $content = $file.IO.slurp;
                    unless $headers.field('Content-Type') {
                        # TODO: LWP::MediaTypes
                        $headers.field(Content-Type => 'application/octet-stream');
                    }
                }
                if $headers.field('Content-Disposition') {
                    $disp = $headers.field('Content-Disposition');
                    $headers.remove-field('Content-Disposition');
                }
                if $headers.field('Content') {
                    $content = $headers.field('Content');
                    $headers.remove-field('Content');
                }
                my $head = ["Content-Disposition: $disp",
                            $headers.Str($CRLF),
                            ""].join($CRLF);
                given $content {
                    when Str {
                        @parts.push: $head ~ $content;
                    }
                    default {
                        die "NYI"
                    }
                }
            }
            default {
                die "unsupported type: {$v.WHAT.gist}({$content.perl})";
            }
        }
    }

    say $content if $HRC_DEBUG;
    say @parts if $HRC_DEBUG;
    return "", "none" unless @parts;

    my $contents;
    # TODO: dynamic upload support
    my $bno = 10;
    CHECK_BOUNDARY: {
        for @parts {
            if $_.index($boundary).defined {
                # must have a better boundary
                $boundary = self.make-boundary(++$bno);
                redo CHECK_BOUNDARY;
            }
        }
    }
    my $generated-content = "--$boundary$CRLF"
                ~ @parts.join("$CRLF--$boundary$CRLF")
                ~ "$CRLF--$boundary--$CRLF";

    return $generated-content, $boundary;
}


method make-boundary(int $size=10) {
    my $str = (1..$size*3).map({(^256).pick.chr}).join('');
    my $b = MIME::Base64.new.encode_base64($str, :oneline);
    $b ~~ s:g/\W/X/;  # ensure alnum only
    $b;
}


method Str (:$debug, Bool :$bin) {
    $.file = '/' ~ $.file unless $.file.starts-with: '/';
    my $s = "$.method $.file $.protocol";
    $s ~= $CRLF ~ callwith($CRLF, :debug($debug), :$bin);
}

method parse($raw_request) {
    my @lines = $raw_request.split($CRLF);
    ($.method, $.file) = @lines.shift.split(' ');

    $.url = 'http://';

    for @lines -> $line {
        if $line ~~ m:i/host:/ {
            $.url ~= $line.split(/\:\s*/)[1];
        }
    }

    $.url ~= $.file;

    self.uri = URI.new($.url) ;

    nextsame;

    self;
}



head

HTTP::Request - class encapsulating HTTP request message


use HTTP::Request;
my $request = HTTP::Request.new(GET => 'http://www.example.com/');


Module provides functionality to easily manage HTTP requests.


multi method new(*%args)
multi method new(Str $method, URI $uri, HTTP::Header $header);


A constructor, the first form takes parameters like:


item

my $req = HTTP::Request.new(:GET<example.com>, :h1<v1>);


The second form takes the key arguments as simple positional parameters and
is designed for use in places where for example the request method may be
calculated and the headers pre-populated.


my $req = HTTP::Request.new;
$req.set-method: 'POST';


method uri(Str $url)
method uri(URI $uri)


my $req = HTTP::Request.new;
$req.uri: 'example.com';


method add-cookies(HTTP::Cookies $cookies)


This will cause the appropriate cookie headers to be added from the
supplied HTTP::Cookies object.


multi method add-form-data(%data, :$multipart)
multi method add-form-data(:$multipart, *%data);
multi method add-form-data(Array $data, :$multipart)


Adds the form data, supplied either as a Hash, an Array of Pair,
or in a named parameter style, to the POST request (it doesn't
make sense on most other request types.) The default is to use
'application/x-www-form-urlencoded' and 'multipart/form-data' can be used
by providing the ':multipart' adverb.  Alternatively a previously applied
"content-type" header of either 'application/x-www-form-urlencoded'
or 'multipart/form-data' will be respected and in the latter case any
applied boundary marker will be retained.


As a special case for multipart data if the value for some key in the data
is an Array of at least one item then it is taken to be a description of a
file to be "uploaded" where the first item is the path to the file to be
inserted, the second (optional) an alternative name to be used in the
content disposition header and the third an optional Array of Pair that
will provide addtional header lines for the part.


method parse(Str $raw_request) returns HTTP::Request


Parses raw HTTP request.
See L<HTTP::Message>


For more documentation, see L<HTTP::Message>.


root

Common

Message

React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


Request

NAME

SYNOPSIS

DESCRIPTION

METHODS

method new

method set-method

method uri

method add-cookies

method add-form-data

method Str

method parse

SEE ALSO