tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

070b602212eeba4693107cd145eae0ec07a9d4db68c4a635676c08707f8fcc3e.tri (3322B)

      1 !import base as B
      2 !import native_math as N
      3 !import http as HTTP
      4 !import io_v2 as IO
      5 !export recvHeaders
      6 !export readBody
      7 !export respond
      8 !export handle
      9 !export handleWith
     10 
     11 -- Reuse pure HTTP grammar/limits. The header cap covers the entire accumulated
     12 -- receive buffer, including prefetched body bytes, exactly as in the v1 reader.
     13 receiveHeaders client buffer count = IO.bind (IO.readSome client 4096) (reply : case reply of
     14   ((t t), (("data", chunk), t)) = let
     15     next = B.append buffer chunk
     16     size = N.add count (HTTP.httpBodyLength chunk)
     17     in case N.lte size HTTP.maxHeaderBytes of
     18       (t t) = case B.contains? HTTP.crlfcrlf next of
     19         (t t) = IO.pure (B.ok next t)
     20         _ = receiveHeaders client next size
     21       _ = IO.pure (B.err 431 t)
     22   _ = IO.pure (B.err 400 t))
     23 recvHeaders client = receiveHeaders client [] 0
     24 
     25 readState _ (0, (reversed, rest)) = IO.pure (B.ok (B.reverse reversed) rest)
     26 readState client (remaining, (reversed, _)) = IO.bind
     27   (IO.readSome client (HTTP.recvChunkMax4096 remaining)) (reply : case reply of
     28     ((t t), (("data", chunk), t)) = readState client (HTTP.takeBodyBytes chunk remaining reversed)
     29     _ = IO.pure (B.err 400 "Unexpected end of request body\n"))
     30 readState _ _ = IO.pure HTTP.httpBadRequest
     31 readBody client fields initial = case HTTP.contentLength fields of
     32   ((t t), (t, _)) = IO.pure (B.ok [] initial)
     33   ((t t), ((t count), _)) = readState client (HTTP.takeBodyBytes initial count [])
     34   failure = IO.pure failure
     35 
     36 -- The connection's owning scope closes it even on partial write/failure. Do not
     37 -- retry uncertain writes or let a cleanup failure turn into a second response.
     38 send client bytes = case HTTP.takeBodyBytes bytes 4096 [] of
     39   (_, ([], _)) = IO.pure t
     40   (_, (reversed, rest)) = IO.require (IO.writeAll client (B.reverse reversed)) (_ : send client rest)
     41   _ = IO.fail "Invalid response byte list"
     42 respond client method response = send client (HTTP.responseForMethod method response)
     43 body router client method target fields ((t t), (bytes, _)) =
     44   router client method target fields bytes
     45 body _ client method _ _ (t, (status, message)) = respond client method (HTTP.errorResponse status message)
     46 body _ client method _ _ _ = respond client method (HTTP.badRequestResponse "Bad Request\n")
     47 fields router client method target version raw = case HTTP.parseHeaders raw of
     48   ((t t), (headers, initial)) = case HTTP.validateRequest method target version headers of
     49     ((t t), _) = IO.bind (readBody client headers initial) (body router client method target headers)
     50     (t, (status, message)) = respond client method (HTTP.errorResponse status message)
     51     _ = respond client method (HTTP.badRequestResponse "Bad Request\n")
     52   _ = respond client "" (HTTP.badRequestResponse "Bad Request\n")
     53 handleWith router client ((t t), ((method, (target, version)), raw)) = fields router client method target version raw
     54 handleWith _ client _ = respond client "" (HTTP.badRequestResponse "Bad Request\n")
     55 
     56 -- Response callbacks run only after the same request grammar/body checks. They
     57 -- may send a bounded native body; framing errors use the ordinary byte response.
     58 handle router client parsed = handleWith
     59   (socket method target headers bytes : IO.bind
     60     (router (HTTP.routerMethod method) target headers bytes) (respond socket method))
     61   client parsed