# TODO: this is only viable behind a reverse proxy.

namespace eval ::httpd {
  variable log [logger::init httpd]
  variable routes

  # https://wiki.tcl-lang.org/page/url-encoding
  proc ::httpd::uri-decode str {
    # rewrite "+" back to space
    # protect \ from quoting another '\'
    set str [string map [list + { } "\\" "\\\\"] $str]

    # prepare to process all %-escapes
    regsub -all -- {%([A-Fa-f0-9][A-Fa-f0-9])} $str {\\u00\1} str

    # process \u unicode mapped chars
    return [subst -novar -nocommand $str]
  }

  # routes: {path proc}
  proc ::httpd::router {name iroutes} {
    variable routes
    variable log
    if [info exists ::httpd::routes($name)] {
      return -code error "Can't create duplicate router!"
    }
    if {[llength $iroutes] % 2 != 0} {
      return -code error "Incorrect number of routes!"
    }

    set routes($name) $iroutes
  }

  proc ::httpd::listen {parent port} {
    socket -server [list ::httpd::accept $parent] $port
  }

  proc ::httpd::accept {parent sock addr port} {
    variable routes

    fconfigure $sock -translation crlf
    gets $sock line
    lassign $line method path version

    if {$method != "GET"} {
      puts $sock "HTTP/1.0 405 Method Not Allowed"
      puts $sock ""
      flush $sock
      close $sock
      return
    }

    set query {}
    if {[string first ? $path] != -1} {
      lassign [split $path ?] path params
      foreach param [split $params &] {
        set value [join [lassign [split $param =] key] =]
        dict lappend query [uri-decode $key] [uri-decode $value]
      }
    }

    set headers {}
    while {[gets $sock header] != -1} {
      if {$header == ""} break
      lassign [split header :] key value
      set key [string tolower [string trim $key]]
      set value [string trim $value]
      dict lappend headers $key $value
    }

    foreach {pathpat proc} [set routes($parent)] {
      if [string match $pathpat $path] {
        if [catch {{*}$proc $parent $sock $path $query $headers} result] {
          puts $sock "HTTP/1.0 500 Internal Server Error"
          puts $sock "Content-Type: text/plain"
          puts $sock ""
          puts $sock "Route Handler: $result"
          puts $sock ""
          flush $sock
          close $sock
          return
        }
        return
      }
    }

    puts $sock "HTTP/1.0 404 Not Found"
    puts $sock "Content-Type: text/plain"
    puts $sock ""
    puts $sock "No route handler available."
    puts $sock ""
    flush $sock
    close $sock
  }

  proc ::httpd::serve {mime payload _ sock _ _ _} {
    puts $sock "HTTP/1.0 200 OK"
    puts $sock "Content-Type: $mime"
    puts $sock "Content-Length: [string length $payload]"
    puts $sock ""
    fconfigure $sock -translation binary
    puts -nonewline $sock $payload
    close $sock
  }
}