## A simple HTTP Daemon role. Inspired by HTTP::Server::Simple
## See HTTP::Easy::PSGI as the default daemon class implementation.

use HTTP::Status;

unit role HTTP::Easy;

has Int:D  $.port   = 8080;
has Str:D  $.host   = '0.0.0.0';
has Bool:D $.debug  = False;
has Bool:D $.silent = False;
has        $!listener;
has        $.connection;    # To be populated by accept().
has        %.env;           # The environment, generated by run().
has        $.http-protocol; # The HTTP version being used.
has        $.body;          # Any request body, populated by run().

## If set to true, we will read the body even if there is no CONTENT_LENGTH.
has Bool $.always-get-body = False;

my constant CRLF             is export = "\x0D\x0A";
my constant DEFAULT_PROTOCOL is export = 'HTTP/1.0';

## We're using DateTime.new(time) instead of DateTime.now()
## Because the current DateTime messes up the user's local timezone
## if they are in a negative offset, which totally screws up the reported
## time, so we are forcing UTC instead.
method message($message --> Nil) {
    note "[{DateTime.now}] $message" unless $.silent;
}

method connect(:port($localport) = $.port, :host($localhost) = $.host) {
    $!listener := IO::Socket::INET.new: :$localhost, :$localport, :listen
}

method run() {
    $!debug = ?%*ENV<HTTP_EASY_DEBUG>;

    self.connect unless $!listener;
    self.message('Started HTTP server.');
    self.pre-connection;
    while $!connection = $!listener.accept {
        self.message("Client connection received.")
          if $!debug;

        self.on-connection;

        my $first-chunk;
        my $msg-body-pos;

        while $!connection.recv(:bin) -> $t {
            self.message("Received a chunk of $t.elems() bytes length")
              if $!debug;

            if $first-chunk.defined {
                $first-chunk = $first-chunk ~ $t;
            }
            else {
                # overwhelmingly often (for simple GET requests, for example) we'll
                # get all data in one run through this loop.
                $first-chunk = $t;
            }

            # Find the header/body separator in the chunk, which means we can parse
            # the header seperately and are able to figure out the
            # correct encoding of the body.

            my int $look_position = 0;
            my int $end_of_buffer = $first-chunk.elems;

            while $look_position < $end_of_buffer - 3 {
                if $first-chunk.AT-POS($look_position) == 13
                  && $first-chunk.AT-POS($look_position + 1) == 10
                  && $first-chunk.AT-POS($look_position + 2) == 13
                  && $first-chunk.AT-POS($look_position + 3) == 10 {
                    $msg-body-pos = $look_position + 2;
                    last;
                }
                else {
                    $look_position = $look_position + 1;
                }
            }

            last if $msg-body-pos;
        }

        without $first-chunk {
            # if we're here, that means our recv timed out.
            # browsers will sometimes open a connection even though there is no
            # request to send yet, to make the next request faster.
            # since we have to be parrot-compatible, we can't use async
            # features, so we'll have to do it the nasty, time-out way.
            self.message("thrown out a connection that sent no data.")
              if $!debug;
            $!connection.close;
            next;
        }

        $!body = $first-chunk.subbuf($msg-body-pos + 2);

        my $preamble = $first-chunk.subbuf(0, $msg-body-pos).decode('ascii');

        self.message("Read preamble:\n$preamble\n--- End of preamble.")
          if $!debug;

        ## End of work around.
        my @headers = $preamble.split("\r\n");
        my $request = @headers.shift;
        without $request {
            self.message("Client connection lost.")
              if $!debug;
            $!connection.close;
            next;
        }
        self.message($request);

        self.message("Finished parsing headers: @headers.raku()")
          if $!debug;

        my ($method, $uri, $protocol) = $request.words;
        $protocol = DEFAULT_PROTOCOL without $protocol;

        unless $method eq 'GET' | 'POST' | 'HEAD' | 'PUT' | 'DELETE' | 'PATCH' {
            $!connection.print(self.unhandled-method);
            $!connection.close;
            next;
        }
        $!http-protocol = $protocol;

        %!env = (); ## Delete the previous hash.
        my ($path, $query) = $uri.split('?', 2);
        $query //= '';

        ## First, let's add our "known" headers.
        %.env<SERVER_PROTOCOL> = $protocol;
        %.env<REQUEST_METHOD>  = $method;
        %.env<QUERY_STRING>    = $query;
        %.env<PATH_INFO>       = $path;
        %.env<REQUEST_URI>     = $uri;
        %.env<SERVER_NAME>     = $.host;
        %.env<SERVER_PORT>     = $.port;
        ## Next, let's add HTTP request headers.
        for @headers -> $header {
            my ($key, $value) = $header.split(': ');
            if $key.defined and $value.defined {
                $key ~~ s:g/\-/_/;
                $key .= uc;
                $key = 'HTTP_' ~ $key unless $key eq 'CONTENT_LENGTH' | 'CONTENT_TYPE';
                if %!env{$key} :exists {
                    %!env{$key} ~= ", $value";
                }
                else {
                    %!env{$key} = $value;
                }
            }
        }

        # Use CONTENT_LENGTH to determine the length of data to read.
        if %.env<CONTENT_LENGTH>:exists {
            if %.env<CONTENT_LENGTH> {
                while %.env<CONTENT_LENGTH> > $!body.bytes {
                    $!body ~= $!connection.recv(%.env<CONTENT_LENGTH> - $!body.bytes, :bin);
                }
#                self.message("Got body: "~$!body.decode) if $!debug;
            }
        }
        elsif $.always-get-body {
            ## No content length. Keep reading until no data is sent.
            while my $read = $!connection.recv(:bin) {
                $!body ~= $read;
            }
        }

        ## Call the handler. 
        ##
        ## If it returns a defined value, it is assumed to be a valid HTTP 
        ## response, in the form of a Str(ing), a Buf, or an object that
        ## can be stringified.
        ##
        ## If it returns an undefined value, we assume the handler
        ## sent the response to the client directly, and end the session.
        with self.handler -> $res {
            $res ~~ Buf
              ?? $!connection.write($res)
              !! $!connection.print($res.Str);
        }
        $!connection.close;
        self.closed-connection;
        self.message("Client connection closed.")
          if $!debug;
    }
    self.finish-connection;
    self.message("Connection finished. Server closed.")
      if $!debug;
}

## Stub methods. Replace with your own.
method pre-connection            {}; ## Runs prior to waiting for connection.
method on-connection             {}; ## Runs at the beginning of each connection.
method closed-connection     {}; ## Runs after closing each connection.
method finished-connection {}; ## Runs when the wait loop is ended.

## The handler method, this MUST be defined in your class.
method handler {...};

## Feel free to override this in your class.
method unhandled-method() {
    my $status  := 501;
    my $message := get_http_status_msg($status);
    "$.http-protocol $status $message";
}

=begin pod

=head1 NAME

HTTP::Easy - HTTP servers made easy, including PSGI

=head1 SYNOPSIS

=begin code :lang<raku>

use HTTP::Easy;

=end code

=head1 DESCRIPTION

Raku libraries to make HTTP servers easily. 

This was inspired by C<HTTP::Server::Simple>, but has a very different
internal API, and extended functionality. It's been designed to work well
with the C<Web::App> and C<SCGI> libraries.

=head2 HTTP::Easy

A role to build HTTP daemon classes with.  This provides the framework
for parsing HTTP connections.

=head2 HTTP::Easy::PSGI

A class consuming the C<HTTP::Easy> role. This builds a PSGI environment,
and passes it onto a handler. The handler must return a C<PSGI> response:

=begin code :lang<raku>

[ $status, @headers, @body ]

=end code

This can be used as an engine in the C<Web::App> library.

=head2 Example

=begin code :lang<raku>

use HTTP::Easy::PSGI;
my $http = HTTP::Easy::PSGI.new(:port(8080));
  
my $app = sub (%env) {
    my $name = %env<QUERY_STRING> || "World";
    [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $name" ] ]
}

$http.handle($app);

=end code

=head1 TODO

Implement HTTP/1.1 features such as Transfer-Encoding, etc.

=head1 AUTHOR

Timothy Totten

=head1 COPYRIGHT AND LICENSE

Copyright 2011 - 2017 Timothy Totten

Copyright 2018 - 2022 Raku Community

This library is free software; you can redistribute it and/or modify
it under the Artistic License 2.0.

=end pod
