-- httpd.lua -- a polyglot-server-in-a-script for calog. The whole HTTP/1.1 protocol -- request
-- parsing, routing, keep-alive, response shaping, and the WebSocket upgrade + frame codec -- lives
-- here in Lua. The only native surface it stands on is calog's generic TCP transport (tcpListen /
-- tcpAccept / tcpRecv / tcpSend / tcpClose from calogNet) and two crypto helpers (cryptoHashSha1 +
-- cryptoBase64Encode + cryptoHexDecode from calogCrypto) for the WebSocket handshake. There is no C
-- HTTP code behind it; this is the calog thesis -- systems primitives in C, protocol in a script.
--
-- Concurrency follows the actor model: one context running server:serve(port) handles connections
-- serially (fine for control/webhook endpoints). For parallelism, share the listener handle across
-- several contexts, each calling tcpAccept on it -- the OS load-balances. Binary-safe strings are
-- required (WebSocket masks and binary bodies carry NUL bytes), so this runs on any calog engine
-- except my-basic, whose char*/strlen strings truncate at the first NUL.
--
-- Usage:
--   local s = httpd.new()
--   s:route("GET", "/hi", function(req) return "hello " .. req.path end)
--   s:route("GET", "/made", function(req) return { status = 201, body = "created" } end)
--   s:websocket("/ws", function(msg) return "echo: " .. msg.message end)   -- returns a text reply or nil
--   s:serve(8080)                                                          -- opts: { keep = fn, acceptTimeout = ms }

local httpd = {}
httpd.__index = httpd

local WS_MAGIC     = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
local HEADER_MAX   = 64 * 1024
local BODY_MAX     = 16 * 1024 * 1024
local RECV_CHUNK   = 8192
local ACCEPT_POLL  = 200   -- ms; the accept loop wakes this often to re-check its keep predicate

local REASON = {
    [101] = "Switching Protocols", [200] = "OK", [201] = "Created", [204] = "No Content",
    [301] = "Moved Permanently",   [302] = "Found", [400] = "Bad Request", [401] = "Unauthorized",
    [403] = "Forbidden", [404] = "Not Found", [405] = "Method Not Allowed", [500] = "Internal Server Error",
}


function httpd.new()
    return setmetatable({ routes = {}, wsRoutes = {} }, httpd)
end


function httpd:route(method, path, handler)
    self.routes[method:upper() .. " " .. path] = handler
end


function httpd:websocket(path, handler)
    self.wsRoutes[path] = handler
end


-- Read one request off the connection, starting from any bytes `buf` already holds from a previous
-- (pipelined) read. Returns (request, leftoverBuffer) or nil on close/malformed. request is
-- { method, path, query, version, headers, body }; leftoverBuffer feeds the next keep-alive read.
local function readRequest(conn, buf)
    buf = buf or ""
    local headerEnd = nil
    while true do
        headerEnd = buf:find("\r\n\r\n", 1, true)
        if headerEnd then break end
        if #buf > HEADER_MAX then return nil end
        local chunk = tcpRecv(conn, RECV_CHUNK)
        if not chunk then return nil end
        buf = buf .. chunk
    end
    local head = buf:sub(1, headerEnd - 1)
    local rest = buf:sub(headerEnd + 4)
    local method, target, version = head:match("^(%S+)%s+(%S+)%s+(%S+)")
    if not method then return nil end
    local path, query = target:match("^([^?]*)%??(.*)$")
    local headers = {}
    for line in head:gmatch("[^\r\n]+") do
        local k, v = line:match("^([^:]+):%s*(.-)%s*$")
        if k then
            k = k:lower()
            -- A conflicting duplicate Content-Length is a CL.CL smuggling vector: reject it.
            if k == "content-length" and headers[k] and headers[k] ~= v then return nil end
            headers[k] = v
        end
    end
    -- We frame bodies by Content-Length only. A Transfer-Encoding (chunked) request would desync with
    -- the leftover-buffer keep-alive path (a TE.CL smuggle), so reject it rather than mis-frame it.
    if headers["transfer-encoding"] then return nil end
    -- Content-Length is DIGIT-only per RFC 7230; reject the hex/scientific/signed/float forms tonumber
    -- would otherwise accept (a body-length desync / smuggling risk), and reject anything over the cap.
    local clen = 0
    local clRaw = headers["content-length"]
    if clRaw then
        if not clRaw:match("^%d+$") then return nil end
        local n = tonumber(clRaw)
        if not n or n > BODY_MAX then return nil end
        clen = math.tointeger(n) or 0
    end
    while #rest < clen do
        local chunk = tcpRecv(conn, RECV_CHUNK)
        if not chunk then return nil end
        rest = rest .. chunk
    end
    local req = {
        method = method:upper(), path = path, query = query, version = version,
        headers = headers, body = rest:sub(1, clen),
    }
    return req, rest:sub(clen + 1)   -- leftover: bytes of the next pipelined request, if any
end


-- HTTP/1.1 keeps the connection alive unless "Connection: close"; HTTP/1.0 closes unless keep-alive.
local function wantsKeepAlive(req)
    local conn = (req.headers["connection"] or ""):lower()
    if req.version == "HTTP/1.1" then
        return not conn:find("close", 1, true)
    end
    return conn:find("keep%-alive") ~= nil
end


-- Turn a handler's return value into an HTTP response and send it. nil -> 204; a string -> 200 with
-- that body; a table -> { status = 200, headers = {}, body = "" }.
local function writeResponse(conn, resp, keepAlive)
    local status, body, extra = 200, "", nil
    if resp == nil then
        status = 204
    elseif type(resp) == "string" then
        body = resp
    elseif type(resp) == "table" then
        status = resp.status or 200
        body   = resp.body or ""
        extra  = resp.headers
    end
    local out = { string.format("HTTP/1.1 %d %s\r\nContent-Length: %d\r\nConnection: %s\r\n",
        status, REASON[status] or "Status", #body, keepAlive and "keep-alive" or "close") }
    if extra then
        for k, v in pairs(extra) do out[#out + 1] = k .. ": " .. v .. "\r\n" end
    end
    out[#out + 1] = "\r\n"
    out[#out + 1] = body
    tcpSend(conn, table.concat(out))   -- raises on a broken connection; httpd:handle's pcall catches it
end


-- ---- WebSocket (RFC 6455) --------------------------------------------------------------------

-- Sec-WebSocket-Accept = base64(SHA1(clientKey + magic GUID)). cryptoHashSha1 returns hex, so decode
-- it back to the 20 raw bytes before base64 -- all via calog's crypto natives, no C here.
local function wsHandshake(conn, req)
    local key = req.headers["sec-websocket-key"]
    if not key then return false end
    local accept = cryptoBase64Encode(cryptoHexDecode(cryptoHashSha1(key .. WS_MAGIC)))
    local resp = "HTTP/1.1 101 Switching Protocols\r\nUpgrade: websocket\r\n" ..
                 "Connection: Upgrade\r\nSec-WebSocket-Accept: " .. accept .. "\r\n\r\n"
    tcpSend(conn, resp)
    return true
end


-- Write one unmasked server frame (FIN set); server-to-client frames are never masked.
local function wsFrame(conn, opcode, payload)
    local len = #payload
    local header
    if len < 126 then
        header = string.char(0x80 | opcode, len)
    elseif len < 65536 then
        header = string.char(0x80 | opcode, 126, (len >> 8) & 0xFF, len & 0xFF)
    else
        local b = { 0x80 | opcode, 127 }
        for i = 7, 0, -1 do b[#b + 1] = (len >> (i * 8)) & 0xFF end
        header = string.char(table.unpack(b))
    end
    tcpSend(conn, header .. payload)
end


-- The message loop: read masked client frames, REASSEMBLE fragmented messages (a data frame with
-- FIN=0 followed by continuation frames, opcode 0x0, until FIN=1), hand each complete text/binary
-- message to the handler as { path, message }, send back any string it returns, answer pings, and
-- stop on close/error. `buf` seeds it with any bytes already read past the upgrade request.
local function wsServe(conn, path, handler, buf)
    buf = buf or ""
    local function need(n)
        while #buf < n do
            local chunk = tcpRecv(conn, RECV_CHUNK)
            if not chunk then return false end
            buf = buf .. chunk
        end
        return true
    end
    local msg = nil    -- accumulated payload of an in-progress fragmented message
    local msgOp = nil  -- opcode (0x1 text / 0x2 binary) of that message's first frame
    while true do
        if not need(2) then return end
        local b1, b2 = buf:byte(1), buf:byte(2)
        local fin    = (b1 & 0x80) ~= 0
        local opcode = b1 & 0x0F
        local masked = (b2 & 0x80) ~= 0
        local len    = b2 & 0x7F
        local pos    = 3
        if len == 126 then
            if not need(4) then return end
            len = (buf:byte(3) << 8) | buf:byte(4)
            pos = 5
        elseif len == 127 then
            if not need(10) then return end
            len = 0
            for i = 3, 10 do len = (len << 8) | buf:byte(i) end
            pos = 11
        end
        -- len is a signed Lua integer: a 64-bit length with bit 63 set reads NEGATIVE, so guard both
        -- ends before trusting it (else it slips past the cap and spins the loop). Client frames MUST
        -- be masked.
        if not masked or len < 0 or len > BODY_MAX then return end
        if not need(pos + 3) then return end
        local mask = { buf:byte(pos), buf:byte(pos + 1), buf:byte(pos + 2), buf:byte(pos + 3) }
        pos = pos + 4
        if not need(pos + len - 1) then return end
        local raw = buf:sub(pos, pos + len - 1)
        buf = buf:sub(pos + len)
        local bytes = {}
        for i = 1, len do bytes[i] = string.char(raw:byte(i) ~ mask[((i - 1) & 3) + 1]) end
        local payload = table.concat(bytes)
        if opcode == 0x8 then
            wsFrame(conn, 0x8, "")
            return
        elseif opcode == 0x9 then
            wsFrame(conn, 0xA, payload)               -- ping -> pong (control frames may interleave)
        elseif opcode == 0xA then
            -- pong: ignore
        elseif opcode == 0x0 or opcode == 0x1 or opcode == 0x2 then
            if opcode == 0x0 then
                if not msgOp then return end          -- continuation with no start frame: protocol error
                msg = msg .. payload
            else
                if msgOp then return end              -- new data frame mid-message: protocol error
                msgOp = opcode
                msg   = payload
            end
            if #msg > BODY_MAX then return end
            if fin then
                local ok, reply = pcall(handler, { path = path, message = msg })
                if ok and type(reply) == "string" then
                    wsFrame(conn, 0x1, reply)
                end
                msg, msgOp = nil, nil
            end
        else
            return   -- unknown opcode: fail the connection
        end
    end
end


-- Serve one connection to completion, then ALWAYS close it. The whole per-connection loop runs under
-- pcall: calogNet raises a Lua error on a socket failure (it does not return nil), so a client that
-- drops mid-request tears down only this connection, never the accept loop. A route handler that
-- errors becomes a 500; a WebSocket handler that errors just drops that reply (see wsServe).
function httpd:handle(conn)
    pcall(function()
        local buf = ""
        while true do
            local req
            req, buf = readRequest(conn, buf)
            if not req then break end
            local upgrade = (req.headers["upgrade"] or ""):lower():find("websocket", 1, true)
            local connhdr = (req.headers["connection"] or ""):lower():find("upgrade", 1, true)
            if upgrade and connhdr then
                local handler = self.wsRoutes[req.path]
                if handler and wsHandshake(conn, req) then
                    wsServe(conn, req.path, handler, buf)   -- hand over any bytes past the upgrade request
                end
                return   -- the connection is now a (closed) WebSocket, not keep-alive HTTP
            end
            local keepAlive = wantsKeepAlive(req)
            local handler = self.routes[req.method .. " " .. req.path] or self.routes["* " .. req.path]
            if handler then
                local ok, resp = pcall(handler, req)
                if ok then
                    writeResponse(conn, resp, keepAlive)
                else
                    writeResponse(conn, { status = 500, body = "Internal Server Error" }, keepAlive)
                end
            else
                writeResponse(conn, { status = 404, body = "Not Found" }, keepAlive)
            end
            if not keepAlive then break end
        end
    end)
    tcpClose(conn)
end


-- Bind `port` and serve until opts.keep() (if given) returns false. opts.acceptTimeout bounds each
-- accept so the keep predicate is polled even with no traffic.
function httpd:serve(port, opts)
    opts = opts or {}
    -- TLS is opt-in via opts.tls + opts.cert + opts.key; pass a clean map to the transport (never the
    -- whole opts table, which may carry Lua function fields like keep/onReady that are not map values).
    local srv
    if opts.tls then
        srv = tcpListen(port, { tls = true, cert = opts.cert, key = opts.key })
    else
        srv = tcpListen(port)
    end
    if not srv then return false end
    if opts.onReady then opts.onReady() end
    local keep = opts.keep
    local timeout = opts.acceptTimeout or ACCEPT_POLL
    while (keep == nil) or keep() do
        -- tcpAccept RAISES on a failed/timed-out TLS handshake (a bad ClientHello, a health-check probe,
        -- a stalled client). Catch it here so one bad connection cannot terminate the accept loop.
        local ok, conn = pcall(tcpAccept, srv, timeout)
        if ok and conn then self:handle(conn) end
    end
    tcpClose(srv)
    return true
end

return httpd