package SPVM::HTTP::Client {
  use SPVM::HTTP::Client::Handle;
  use SPVM::HTTP::URL;
  use SPVM::StringList;

  has default_headers : public SPVM::Hash;
  has timeout : public double;

  sub new : SPVM::HTTP::Client () {
    my $self = new SPVM::HTTP::Client;
    $self->{default_headers} = SPVM::Hash->newa([]);
    $self->{timeout} = 60;
    return $self;
  }

  sub new_opt : SPVM::HTTP::Client ($args : object[]) {

    my $h = SPVM::Hash->newa($args);
    my $self = new SPVM::HTTP::Client;
    my $headers = (SPVM::Hash)$h->get("default_headers");
    $self->{default_headers} = SPVM::Hash->new;
    my $keys = $headers->keys;
    for (my $i = 0; $i < @$keys; ++$i) {
      $self->{default_headers}->set(lc($keys->[$i]), $headers->get($keys->[$i]));
    }
    $self->{timeout} = 60;
    return $self;
  }

  private sub _prepare_headers : SPVM::Hash ($self : self, $host : string, $port : int) {
    my $headers = $self->{default_headers}->copy;
    if ($port && $port != 80) {
      $host .= ":$port";
    }
    $headers->set("host", $host);
    return $headers;
  }

  private sub _open_handle : SPVM::HTTP::Client::Handle ($self : self,
      $host : string, $port : int) {
    my $handle = SPVM::HTTP::Client::Handle->new_opt([(object)
      timeout => $self->{timeout},
    ]);
    return $handle->connect(SPVM::Hash->newa([(object)
      host => $host,
      port => $port,
    ]));
  }

  sub request : void ($self : self, $method : string,
      $url : string, $args : object[]) {

    my $u = SPVM::HTTP::URL->parse($url);
    $u->force_root_path_slashed;
    my $host = $u->{host};
    my $port = $u->{port};
    my $path_query = $u->{path};
    if ($u->{params} && $u->{params}->to_str ne "") {
      $path_query .= "?" . $u->{params}->to_str;
    }
    my $headers = $self->_prepare_headers($host, $port);
    my $handle = $self->_open_handle($host, $port);
    $handle->write_request($method, $path_query, $headers);

    my $response = $handle->read_response_header;

    my $known_message_length : int;
    if ($method eq "HEAD" || ($response->{status} == 204 || $response->{status} == 304)) {
      $known_message_length = 1;
    }
    else {
      $known_message_length = $handle->read_body($response);
    }

    $response->{success} = $response->{status} / 100 == 2;
    $response->{url} = $url;

    warn("-----------------");
    warn($response->to_str);
    warn("-----------------");
  }
}

package SPVM::HTTP::Client::Handle {
  use SPVM::HTTP::Client::Response;
  use SPVM::IO::Socket;
  use SPVM::StringBuffer;

  has timeout : public double;
  has socket : public SPVM::IO::Socket;
  has rbuf : SPVM::StringBuffer;
  has max_header_lines : int;

  our $_BUFSIZE : rw int;

  BEGIN {
    $_BUFSIZE = 32768;
  }

  sub new_opt : SPVM::HTTP::Client::Handle ($args : object[]) {
    my $h = SPVM::Hash->newa($args);
    my $self = new SPVM::HTTP::Client::Handle;
    if (my $o = $h->get("timeout")) {
      $self->{timeout} = ((SPVM::Double)$o)->val;
    }
    $self->{rbuf} = SPVM::StringBuffer->new;
    if (my $o = $h->get("max_header_lines")) {
      $self->{max_header_lines} = ((SPVM::Int)$o)->val;
    }
    else {
      $self->{max_header_lines} = 64;
    }
    return $self;
  }

  sub connect : SPVM::HTTP::Client::Handle ($self : self, $args : SPVM::Hash) {
    unless ($args->exists("host")) {
      die "Missing argument 'host'.";
    }
    my $host = (string)($args->get("host"));
    unless ($args->exists("port")) {
      die "Missing argument 'port'.";
    }
    my $port = ((SPVM::Int)($args->get("port")))->val;
    $self->{socket} = SPVM::IO::Socket->new($host, $port);
    $self->{rbuf} = SPVM::StringBuffer->new;
    return $self;
  }

  sub write : void ($self : self, $buf : SPVM::StringBuffer) {
    my $len = $buf->length;
    my $off = 0;
    while (1) {
      my $writable = $buf->substr($off, $len)->to_str;
      warn($writable);
      my $write_length = $self->{socket}->write($writable, $len);
      $len -= $write_length;
      $off += $write_length;
      unless ($len > 0) {
        last;
      }
    }
  }

  sub write_header_lines : void ($self : self,
      $headers : SPVM::Hash, $prefix_data : string) {
    my $buf = SPVM::StringBuffer->new;
    if ($prefix_data) {
      $buf->append_string($prefix_data);
    }
    my $control_fields = ["host", "cache-control", "expect", "max-forwards", "pragma", "range", "te"];
    my $seen = SPVM::Hash->new;
    for (my $i = 0; $i < @$control_fields; ++$i) {
      if (my $v = $headers->get($control_fields->[$i])) {
        $buf->append_string($control_fields->[$i] . ": " . (string)$v . "\r\n");
        $seen->set($control_fields->[$i], 1);
      }
    }
    my $ks = $headers->keys;
    for (my $i = 0; $i < @$ks; ++$i) {
      unless ($seen->get($ks->[$i])) {
        $buf->append_string($ks->[$i] . ": " .
            (string)($headers->get($ks->[$i])) . "\r\n");
      }
    }
    $buf->append_string("\r\n");
    $self->write($buf);
  }

  sub write_request_header : void ($self : self, $method : string,
      $path_query : string, $headers : SPVM::Hash) {
    $self->write_header_lines($headers, "$method $path_query HTTP/1.1\r\n");
  }

  sub write_request : void ($self : self, $method : string, $path_query : string,
      $headers : SPVM::Hash) {
    $self->write_request_header($method, $path_query, $headers);
    #$self->_write_body();
  }

  private sub _extract_line : string ($self : self) {
    my $index = $self->{rbuf}->index("\n", 0);
    if ($index < 0) {
      return undef;
    }
    my $ret = $self->{rbuf}->substr(0, $index + 1)->to_str;
    if ($self->{rbuf}->length == $index + 1) {
      $self->{rbuf} = SPVM::StringBuffer->new;
    }
    else {
      $self->{rbuf} = $self->{rbuf}->substr(
          $index + 1, $self->{rbuf}->length - $index - 1);
    }
    return $ret;
  }

  sub readline : string ($self : self) {
    while (1) {
      if (my $line = $self->_extract_line) {
        return $line;
      }
      my $buf = new byte [$_BUFSIZE];
      my $r = $self->{socket}->read($buf);
      if ($r > 0) {
        $self->{rbuf}->append_bytes(sliceb($buf, 0, $r));
      }
      elsif ($r == 0) {
        die "Unexpected end of stream while looking for line";
      }
    }
    return $self->{rbuf}->to_str;
  }

  private sub _read_as : void ($target : string, $token : string, $pos : int&) {
    unless (index($target, $token, $$pos) == 0) {
      die "Malformed string. '$token' is expected: '$target'";
    }
    $$pos += length $token;
  }

  private sub _read_as_ws : void ($target : string, $pos : int&) {
    unless ($target->[$$pos] == ' ' || $target->[$$pos] == '\t') {
      die "Malformed string. No white spaces: '$target'";
    }
    my $len = length $target;
    for (; $$pos < $len &&
        $target->[$$pos] == ' ' ||
        $target->[$$pos] == '\t';
        ++$$pos) {}
  }

  private sub _capture : string ($target : string, $length : int, $pos : int&) {
    my $ret = "";
    eval {
      $ret = substr($target, $$pos, $length);
    };
    if ($@) {
      die "Malformed string, parse failed at " . $$pos . ". string: '$target'";
    }
    $$pos += $length;
    return $ret;
  }

  private sub _as_digits : int ($string : string) {
    my $length = length $string;
    my $ret = 0;
    for (my $i = 0; $i < $length; ++$i) {
      $ret *= 10;
      $ret += $string->[$i] - '0';
    }
    return $ret;
  }

  private sub _trim_left : string ($string : string) {
    my $length = length $string;
    for (my $i = 0; $i < $length; ++$i) {
      if ($string->[$i] != ' ') {
        return substr($string, $i, $length - $i);
      }
    }
    return "";
  }

  private sub _header_field : string[] ($line : string) {
    my $length = length $line;
    my $name = "";
    for (my $i = 0; $i < $length; ++$i) {
      my $c = $line->[$i];
      if ($c == ':') {
        my $value = substr($line, $i + 1, index($line, "\r\n", $i + 1) - $i - 1);
        $value = _trim_left($value);
        return [$name, $value];
      }
      unless (('\x00' <= $c && $c <= '\x1F') || $c == '\x7F') { # control codes
        $name .= [$c];
      }
    }
    return undef;
  }

  private sub _read_header_lines : SPVM::Hash ($self : self, $headers : SPVM::Hash) {
    my $lines = 0;
    unless ($headers) {
      $headers = SPVM::Hash->newa([]);
    }
    while (1) {
      if (++$lines >= $self->{max_header_lines}) {
        die "Header lines exceeds maximum number allowed of " . $self->{max_header_lines};
      }
      my $line = $self->readline;
      if (my $header_field = _header_field($line)) {
        my $field_name = lc($header_field->[0]);
        my $field_value = $header_field->[1];
        if (my $o = $headers->get($field_name)) {
          my $p : SPVM::StringList;
          if ($o isa string) {
            $p = SPVM::StringList->newa([(string)$o]);
          }
          else {
            $p = (SPVM::StringList)$o;
          }
          $p->push($field_value);
        }
        else {
          $headers->set($field_name, $field_value);
        }
      }
      elsif ($line eq "\r\n" || $line eq "\n") {
        last;
      }
      else {
        die "Malformed header line: '$line'";
      }
    }
    return $headers;
  }

  sub read_response_header : SPVM::HTTP::Client::Response ($self : self) {
    my $line = $self->readline;
    my $pos = 0;
    _read_as($line, "HTTP/", \$pos);
    my $version = _capture($line, 3, \$pos);
    unless ($version eq "1.0" || $version eq "1.1") {
      die "Unsupported HTTP protocol HTTP/$version";
    }
    _read_as_ws($line, \$pos);
    my $status = _capture($line, 3, \$pos);
    _read_as_ws($line, \$pos);
    my $reason = substr($line, $pos, length($line) - $pos - 2);
    return SPVM::HTTP::Client::Response->new_opt([(object)
      protocol => "HTTP/$version",
      status   => _as_digits($status),
      reason   => $reason,
      headers  => $self->_read_header_lines(undef),
    ]);
  }

  private sub _read_hex_length : int ($self : self) {
    my $line = $self->readline;
    if (length($line) <= 2) {
      die "Malformed chunk-size: '$line'";
    }
    my $length : int;
    eval {
      $length = hexi(substr($line, 0, length($line) - 2));
    };
    if ($@) {
      die "Malformed chunk-size. " . $@;
    }
    else {
      return $length;
    }
  }

  private sub _read : int ($self : self, $len : int,
      $buf : SPVM::StringBuffer, $allow_partial : int) {

    my $updated = 0;

    if (my $got = $self->{rbuf}->length) {
      $updated = 1;
      my $take = $len;
      if ($take > $got) {
        $take = $got;
      }
      $buf->append($self->{rbuf}->substr(0, $take));
      if ($got > $take) {
        $self->{rbuf} = $self->{rbuf}->substr($take, $got - $take);
      }
      else {
        $self->{rbuf} = SPVM::StringBuffer->new;
      }
      $len -= $take;
    }

    while ($len > 0) {
      my $chunk = new byte [$len];
      my $read_len : int;
      eval {
        $read_len = $self->{socket}->read($chunk);
      };
      if ($@) {
        die "Could not read from socket: '" . $@ . "'";
      }

      if ($read_len) {
        $updated = 1;
        $buf->append_bytes(sliceb($chunk, 0, $read_len));
        $len -= $read_len;
      }
      else {
        last;
      }
    }

    if ($len && !$allow_partial) {
      die "Unexpected end of stream";
    }

    return $updated;
  }

  private sub _read_chunked_body : int ($self : self,
      $response : SPVM::HTTP::Client::Response) {
    while (1) {
      my $len = $self->_read_hex_length;
      if ($len > 0) {
        $self->_read_content_body($response, $len);
        unless ($self->readline eq "\r\n") {
          die "Malformed chunk: missing CRLF after chunk data";
        }
      }
      else {
        last;
      }
    }
    $self->_read_header_lines($response->{headers});
    return 1;
  }

  private sub _read_content_body : int ($self : self,
      $response : SPVM::HTTP::Client::Response, $content_length : SPVM::Int) {
    if (!$content_length) {
      if (my $o = $response->{headers}->get("content-length")) {
        $content_length = stoi((string)$o);
      }
    }
    if ($content_length) {
      my $len = $content_length->val;
      my $buf = SPVM::StringBuffer->new;
      while ($len > 0) {
        my $read = $len;
        if ($len > $_BUFSIZE) {
          $read = $_BUFSIZE;
        }
        $self->_read($read, $buf, 0);
        $len -= $read;
      }
      $response->{content} .= $buf->to_str;
      return $self->{rbuf}->length == 0;
    }
    else {
      my $buf = SPVM::StringBuffer->new;
      while (1) {
        unless ($self->_read($_BUFSIZE, $buf, 1)) {
          last;
        }
      }
      $response->{content} .= $buf->to_str;
      return 0;
    }
  }

  private sub _has_chunked : int ($te : object) {
    if ($te isa string) {
      if ((string)$te eq "chunked") {
        return 1;
      }
    }
    elsif (((SPVM::StringList)$te)->grep("chunked")) {
      return 1;
    }
    return 0;
  }

  sub read_body : int ($self : self, $response : SPVM::HTTP::Client::Response) {
    my $te = $response->{headers}->get("transfer-encoding");
    if ($te && _has_chunked($te)) {
      return $self->_read_chunked_body($response);
    }
    else {
      return $self->_read_content_body($response, undef);
    }
  }
}
