"../http.spl" import
"../server.spl" import

"Server" net:http:register
"server" net:http:register

construct net:http:Server {
	ifaddr
	port
	stream
	;
	construct { this | with ifaddr port this ;
		ifaddr this:=ifaddr;
		port this:=port;
		ifaddr port net:server:Types:tcp:create this:=stream;
		this
	}
	accept { net:http:server:Request | with this ;
		this this:stream:accept net:http:server:Request:new
	}
	close { | with this ; this:stream:close; }
}

construct net:http:server namespace {
	Request
	;
    register { | with name this ;
        name "net:http:server" register-field
    }
}

construct net:http:server:Request {
	server
	stream
	head
	body
	method raw-path version
	path query
	headers
	wrote-body
	;
	construct { this | with server stream this ;
		server this:=server
		stream this:=stream
		0 anew this:=head
		0 anew this:=body
		this
	}
	read-head { this | with this ;
		def read
		def buf 1024 anew =buf
		def found
		while {
			buf this:stream:read pop =read
			"\r\n\r\n" :to-bytes buf:find dup =found not read and
		} {
			this:head buf:sub<0 read> aadd this:=head
		}
		this:head buf:sub<0 found> aadd:to-str this:=head
		buf:sub<found 4 + buf:len> this:=body
		this
	}
	parse-head { this | with this ;
		this:head:split<"\r\n"> this:=head
		def iter this:head:iter =iter
		iter:next:readf<"{} {} HTTP/{}"> dup if {
			dup:to-stack this:=version this:=raw-path this:=method
		} pop
		MicroMap:new this:=query
		def p "{}?{}" this:raw-path:readf =p
		this:raw-path
		p if {
			{ | with attrib ;
				"{}={}" attrib:readf dup if {
					dup:to-stack this:query:set;
				} not if {
					attrib "" this:query:set;
				}
			} "&" p:1:split:foreach
			pop p:0
		} this:=path
		MicroMap:new this:=headers
		iter:foreach<{ | with header ;
			header:readf<"{}: {}"> dup if {
				dup:to-stack swap:lowercase swap this:headers:set;
			} pop
		}>
		this
	}
	head-str { str | with this ;
		this:method
		" " concat
		this:raw-path concat
		" HTTP/" concat
		this:version concat
		"\r\n" concat
		this:headers:foreach<{ | :to-stack ": " swap concat concat concat "\r\n" concat }>
		"\r\n" concat
	}
	read-body { this | with this ;
		this:headers:get<"content-length"> dup if { _mega with content-length ;
			def read
			def buf 1024 anew =buf
			while {
				this:body:len content-length lt read and
			} {
				this:body buf:sub<0 read> aadd this:=body
				buf this:stream:read pop =read
			}
			null
		} pop
		this
	}
	read { this | with this ;
		this:read-head:parse-head:read-body
	}
	writeln { this | with line this ;
		line "\r\n" concat :to-bytes this:stream:write-exact;
		this
	}
	write-head { this | with status-code status-string this ;
		"HTTP/1.0 " status-code _str concat " " concat status-string concat this:writeln
	}
	write-ok { this | with this ;
		200 "OK" this:write-head
	}
	write-header { this | with header value this ;
		header ": " concat value _str concat this:writeln
	}
	write-content-type { this | with ct this ;
		"Content-Type" ct this:write-header
	}
	write-str-body { this | with body this ;
		body:to-bytes this:write-body
	}
	write-html-body { this | with body this ;
		"text/html" this:write-content-type;
		body:to-bytes this:write-body
	}
	write-body { this | with body this ;
		"Content-Length" body:len this:write-header;
		"" this:writeln;
		1 this:=wrote-body;
		body this:stream:write-exact;
		this
	}
	finish { | with this ;
		this:wrote-body not if {
			0 anew this:write-body;
		}
		this:stream:close;
	}
	is-open { bool | with this ;
		this:wrote-body not
	}
}