#
# Copyright (c) 2012-2019, 2023, 2025-2026 LAAS/CNRS
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software for any purpose
# with or without   fee is hereby granted, provided   that the above  copyright
# notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS  SOFTWARE INCLUDING ALL  IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL THE AUTHOR  BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR  ANY DAMAGES WHATSOEVER RESULTING  FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION,   ARISING OUT OF OR IN    CONNECTION WITH THE USE   OR
# PERFORMANCE OF THIS SOFTWARE.
#
#                                            Anthony Mallet on Fri Mar 23 2012
#

namespace eval server {
  variable sock		{}
  variable channels	[dict create]


  # --- start --------------------------------------------------------------
  #
  proc start { port } {
    variable sock
    set sock [socket -server [namespace code accept] $port]
  }
  namespace export start


  # --- accept -------------------------------------------------------------
  #
  proc accept { channel addr port } {
    variable channels
    infox "connection from $addr:$port on $channel"

    dict set channels $channel [dict create state idle]

    # nodelay helps when sending just a bit more data than a multiple of the
    # MTU, typically when reading ports.
    genomix::sockopt $channel -nodelay 1

    # Set channel buffer sizes compatible with socket buffer
    fconfigure $channel -buffersize [genomix::sockopt $channel -sndbuf]

    fconfigure $channel -buffering full
    fconfigure $channel -blocking 0
    fconfigure $channel -encoding utf-8
    fileevent $channel readable [namespace code [list eval $channel]]
  }


  # --- terminate ----------------------------------------------------------
  #
  proc terminate { channel } {
    variable channels

    infox "$channel: disconnecting"
    session::clean $channel
    close $channel
    dict unset channels $channel
  }
  namespace export terminate


  # --- eval ---------------------------------------------------------------
  #
  proc eval { channel } {
    variable channels

    # minimalistic http/1.1 state machine
    while 1 {
      switch [dict get $channels $channel state] {
        idle {
          if {[gets $channel cmd] < 0} {
            if {[eof $channel]} { terminate $channel }
            return
          }
          infox "$channel: received \"$cmd\"" 1

          lassign $cmd method uri
          set uri [uri decode-args $uri args]

          dict set channels $channel method $method
          dict set channels $channel uri $uri
          dict set channels $channel args $args
          dict set channels $channel headers {}
          dict set channels $channel state headers
        }

        headers {
          if {[gets $channel cmd] < 0} {
            if {[eof $channel]} { terminate $channel }
            return
          }
          infox "$channel: received \"$cmd\"" 1

          if {$cmd == ""} {
            dict set channels $channel body {}
            if {[dict exists $channels $channel headers content-length]} {
              infox "$channel: content-length header, now expecting body" 1
              dict set channels $channel state body
            } else {
              infox "$channel: processing request on $channel" 1
              dispatch $channel [dict get $channels $channel]
              dict set channels $channel state idle
              return
            }
          } else {
            set kv [string first : $cmd]
            if {$kv > 0} {
              set k [string tolower [string trim [string range $cmd 0 $kv-1]]]
              set v [string trim [string range $cmd $kv+1 end]]
              infox "$channel: header \"$k\", value \"$v\"" 1
              dict set channels $channel headers $k $v
            }
          }
        }

        body {
          set body [dict get $channels $channel body]
          set got [string bytelength $body]
          set expect [dict get $channels $channel headers content-length]

          if {$got < $expect} {
            set cmd [read $channel [expr {$expect-$got}]]
            append body $cmd
            dict set channels $channel body $body
            set got [string bytelength $body]
          }

          if {$got >= $expect} {
            infox "$channel: processing request on $channel" 1
            dispatch $channel [dict get $channels $channel]
            dict set channels $channel state idle
            return
          } else {
            infox "$channel: got $got bytes out of $expect" 1
          }
        }
      }
    }
  }


  # --- ignore -------------------------------------------------------------
  #
  proc ignore { channel } {
    read $channel
    if {[eof $channel]} { terminate $channel }
    return
  }


  # --- reply --------------------------------------------------------------
  #
  proc reply { channel status msg } {
    switch -glob [expr {$status}] {
      2[0-9][0-9] { infox "$channel: reply: $msg" 1 }
      default {
        warnx "$channel: status $status: $msg"
        if {[string index $msg 0] != "\{"} {
          set msg \"[string map {\\ \\\\ \" \\\"} $msg]\"
        }
      }
    }

    switch [expr {$status}] {
      200 { set status "200 OK" }
      201 { set status "201 Created" }
      202 { set status "202 Accepted" }
      400 { set status "400 Bad Request" }
      404 { set status "404 Not Found" }
      429 { set status "429 Too Many Requests" }
    }

    set len [string bytelength "$msg"]
    set r [catch {
      set data		"HTTP/1.1 $status\n"
      append data	"Content-Type: application/json\n"
      append data	"Content-Length: $len\n"
      append data	"\n"
      append data	$msg
      puts -nonewline $channel $data
      flush $channel
    } m]
    if {$r} {
      warnx "$channel: $m"
      terminate $channel
    }

    infox "$channel: status $status"
  }


  # --- stream -------------------------------------------------------------
  #
  proc stream { channel } {
    set r [catch {
      infox "$channel: set to streaming mode" 1

      fileevent $channel readable [namespace code [list ignore $channel]]
      puts $channel "HTTP/1.1 200 OK"
      puts $channel "Content-Type: text/event-stream"
      puts $channel ""
      flush $channel
    } m]
    if {$r} {
      warnx "$channel: $m"
      terminate $channel
    }
  }
  namespace export stream


  # --- dispatch -----------------------------------------------------------
  #
  proc dispatch { channel request } {
    set method [dict get $request method]
    set uri [dict get $request uri]
    set body [dict get $request body]

    catch {dict get $request headers content-type} ctype
    if {$ctype == "application/x-www-form-urlencoded"} {
      uri decode-form $body args
      dict set request args [dict merge [dict get $request args] $args]
    }
    set args [dict get $request args]

    set log "$channel: $method $uri"
    dict for {k v} $args { append log " $k=$v" }
    infox $log

    set uril [file split $uri]
    switch [lindex $uril 1] {
      {module} {
        set m [lindex $uril 2]
        set c [lindex $uril 3]
        set mcmd [info commands ::genomix::client::$m]
        if {$mcmd == ""} {
          reply $channel 404 $m
          return
        }
        set e [catch {
          switch $c {
            send {
              if {[catch {dict get $args input} input]} {
                set input "{}"
              }
              set r [$mcmd send [lindex $uril 4] $input]
              if {[dict exists $args oneway]} {
                set r ""
              } else {
                request::new $m $r $args
              }
            }
            read - portconnect - portdisconnect {
              set p [lindex $uril 4]
              set n [lindex $uril 5]
              set r [$mcmd $c $p $n]
            }
            pub {
              lassign [lrange $uril 4 5] p op
              if {[catch {dict get $args id} id]} {
                reply $channel 400 "Bad request: \"$uri\""
              }
              if {[catch {dict get $args data} data]} {
                set data [dict create]
              }
              set r [$mcmd pub $p $op $id $data]
            }
            unload {
              session::broadcast unload $m
              request::clean-all $m $args
              rename $mcmd {}
              set r "unloaded $m"
            }
            status - abort - clean {
              set id [lindex $uril 4]
              set r [request::$c $m $id]
            }
            default {
              set r [$mcmd $c]
            }
          }
          reply $channel 200 $r
        } r]
        if {$e} {
          switch -glob $r {
            *genom::too_many_activities* { reply $channel 429 $r }
            default { reply $channel 400 $r }
          }
        }
      }

      {session} {
        set e [catch {
          # manage sessions
          set c [lindex $uril 2]
          set r [session $c $channel $args]
          if {$c != "listen"} { reply $channel 200 $r }
        } r]
        if {$e} { reply $channel 400 $r }
      }

      {rpath} {
        set e [catch {
          # add a load path
          set p [file join / {*}[lrange $uril 2 end]]
          set r [genomix rpath $p $args]
          reply $channel 200 $r
        } r]
        if {$e} { reply $channel 404 $r }
      }

      {usage} {
        set e [catch {
          # get module usage
          set p [file join {*}[lrange $uril 2 end]]
          set r [genomix usage $p]
          reply $channel 200 $r
        } r]
        if {$e} { reply $channel 404 $r }
      }

      {load} {
        set e [catch {
          # load module
          if {[llength $uril] > 1} {
            set p [file join / {*}[lrange $uril 2 end]]
          } else {
            set p $uril
          }
          set r [genomix load $p [dict get $args argv] ::request::event]
          reply $channel 201 $r
        } r]
        if {$e} { reply $channel 404 $r }
      }

      {version} {
        reply $channel 200 [package present genomixd]
      }

      default {
        reply $channel 400 "Bad request: \"$uri\""
      }
    }

    return
  }


  # create 'server' command
  namespace ensemble create
}
