tricu

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

b881a086294ff264567d758dd2c1ef7a3470faa909ec588e9f7bb8c4430f7bfc.tri (2988B)

      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 
     10 -- Reuse pure HTTP grammar/limits. The header cap covers the entire accumulated
     11 -- receive buffer, including prefetched body bytes, exactly as in the v1 reader.
     12 receiveHeaders client buffer count = IO.bind (IO.readSome client 4096) (reply : case reply of
     13   ((t t), (("data", chunk), t)) = let
     14     next = B.append buffer chunk
     15     size = N.add count (HTTP.httpBodyLength chunk)
     16     in case N.lte size HTTP.maxHeaderBytes of
     17       (t t) = case B.contains? HTTP.crlfcrlf next of
     18         (t t) = IO.pure (B.ok next t)
     19         _ = receiveHeaders client next size
     20       _ = IO.pure (B.err 431 t)
     21   _ = IO.pure (B.err 400 t))
     22 recvHeaders client = receiveHeaders client [] 0
     23 
     24 readState _ (0, (reversed, rest)) = IO.pure (B.ok (B.reverse reversed) rest)
     25 readState client (remaining, (reversed, _)) = IO.bind
     26   (IO.readSome client (HTTP.recvChunkMax4096 remaining)) (reply : case reply of
     27     ((t t), (("data", chunk), t)) = readState client (HTTP.takeBodyBytes chunk remaining reversed)
     28     _ = IO.pure (B.err 400 "Unexpected end of request body\n"))
     29 readState _ _ = IO.pure HTTP.httpBadRequest
     30 readBody client fields initial = case HTTP.contentLength fields of
     31   ((t t), (t, _)) = IO.pure (B.ok [] initial)
     32   ((t t), ((t count), _)) = readState client (HTTP.takeBodyBytes initial count [])
     33   failure = IO.pure failure
     34 
     35 -- The connection's owning scope closes it even on partial write/failure. Do not
     36 -- retry uncertain writes or let a cleanup failure turn into a second response.
     37 send client bytes = case HTTP.takeBodyBytes bytes 4096 [] of
     38   (_, ([], _)) = IO.pure t
     39   (_, (reversed, rest)) = IO.require (IO.writeAll client (B.reverse reversed)) (_ : send client rest)
     40   _ = IO.fail "Invalid response byte list"
     41 respond client method response = send client (HTTP.responseForMethod method response)
     42 body router client method target fields ((t t), (bytes, _)) = IO.bind
     43   (router (HTTP.routerMethod method) target fields bytes) (respond client method)
     44 body _ client method _ _ (t, (status, message)) = respond client method (HTTP.errorResponse status message)
     45 body _ client method _ _ _ = respond client method (HTTP.badRequestResponse "Bad Request\n")
     46 fields router client method target version raw = case HTTP.parseHeaders raw of
     47   ((t t), (headers, initial)) = case HTTP.validateRequest method target version headers of
     48     ((t t), _) = IO.bind (readBody client headers initial) (body router client method target headers)
     49     (t, (status, message)) = respond client method (HTTP.errorResponse status message)
     50     _ = respond client method (HTTP.badRequestResponse "Bad Request\n")
     51   _ = respond client "" (HTTP.badRequestResponse "Bad Request\n")
     52 handle router client ((t t), ((method, (target, version)), raw)) = fields router client method target version raw
     53 handle _ client _ = respond client "" (HTTP.badRequestResponse "Bad Request\n")