server.bend

gralha-http-server@0.1.0.0 · 182 lines · 22 definitions

1# An HTTP/1.1 server over Base's TCP: one request per connection, answered
2# and closed, one connection at a time. The app's state threads through
3# the handler, a template (~), so it runs inline and may run every time.
4import Base
5import gralha-http-core@0.1.0.0/http.bend as Http
6
7# Reading
8# =======
9
10def read.chunk(socket: Socket, +text: String, +max: U32, next: Socket -> String -> IO(Socket & String)) ->
11  IO(Socket & String):
12  Http.when(Socket -> IO(Socket & String), Http.request.complete(text) || U32.is_gt(Http.utf8.length(text), max),
13    _ => s => IO.pure(Socket & String, (s, text)), _ => s => next(s)(text))(socket)
14
15def read.got(got: Socket & Result<&1, &1, U32 & String, Maybe<&1, String>>, acc: String, +max: U32,
16  next: Socket -> String -> IO(Socket & String)) -> IO(Socket & String):
17  (socket, result) = got
18  match result:
19    case Fail{err}:
20      IO.pure(Socket & String, (socket, ""))
21    case Done{None{}}:
22      IO.pure(Socket & String, (socket, acc))
23    case Done{Some{data}}:
24      read.chunk(socket, acc ++ data, max, next)
25
26def read.go?(socket: Socket, +max: U32, acc: String) -> IO(Socket & String):
27  do IO<Socket & String>:
28    got : Socket & Result<&1, &1, U32 & String, Maybe<&1, String>> <- TCP.recv(socket, 65536)
29    read.got(got, acc, max, s => text => read.go(s, max, text))
30
31# The request's text: received until it is whole (Http.request.complete),
32# the peer stops sending, or more than max bytes arrived; "" on an error.
33def read.text(socket: Socket, +max: U32) -> IO(Socket & String):
34  read.go(socket, max, "")
35
36def read.parse(got: Socket & String) -> IO(Socket & Maybe<&2, Http.Request>):
37  (socket, text) = got
38  IO.pure(Socket & Maybe<&2, Http.Request>, (socket, Http.request.parse(text)))
39
40# The request read and parsed, or None if it never became one.
41def read(socket: Socket, +max: U32) -> IO(Socket & Maybe<&2, Http.Request>):
42  do IO<Socket & Maybe<&2, Http.Request>>:
43    got : Socket & String <- read.text(socket, max)
44    read.parse(got)
45
46# Sending
47# =======
48
49# A failed send also hands back the unsent rest, which a closing reply drops.
50def send.done(got: Socket & Result<&1, &1, (U32 & String) & List<&2, U32>, Unit>) -> IO(Unit):
51  (socket, result) = got
52  Socket.close(socket)
53
54# Sends text as it is and closes the socket.
55def send.text(socket: Socket, text: String) -> IO(Unit):
56  do IO<Unit>:
57    sent : Socket & Result<&1, &1, (U32 & String) & List<&2, U32>, Unit> <- TCP.send(socket, text)
58    send.done(sent)
59
60# The response with Connection: close, unless it names a Connection.
61def closing(r: Http.Response) -> Http.Response:
62  match r:
63    case Http.Response{+s, +h, +b}:
64      Http.when(Http.Response, Http.header.has(h, "connection"), _ => Http.Response{s, h, b},
65        _ => Http.response.with(Http.Response{s, h, b}, "Connection", "close"))
66
67# Sends a response (Http.response.text, with Connection: close) and closes
68# the socket.
69def send(socket: Socket, r: Http.Response) -> IO(Unit):
70  send.text(socket, Http.response.text(closing(r)))
71
72# Serving
73# =======
74
75def answer.sent(-S: Type, socket: Socket, out: S & Http.Response) -> IO(S):
76  (state, r) = out
77  do IO<S>:
78    Unit <- send(socket, r)
79    return state
80
81def answer(~S: Type, ~handle: Http.Request -> S -> IO(S & Http.Response),
82  got: Socket & Maybe<&2, Http.Request>, state: S) -> IO(S):
83  (socket, request) = got
84  match request:
85    case None{}:
86      do IO<S>:
87        Unit <- send(socket, Http.status(400))
88        return state
89    case Some{r}:
90      do IO<S>:
91        out : S & Http.Response <- handle(r)(state)
92        answer.sent(S, socket, out)
93
94def answer.socket(~S: Type, ~reply: Socket -> Http.Request -> S -> IO(S),
95  got: Socket & Maybe<&2, Http.Request>, state: S) -> IO(S):
96  (socket, request) = got
97  match request:
98    case None{}:
99      do IO<S>:
100        Unit <- send(socket, Http.status(400))
101        return state
102    case Some{r}:
103      reply(socket)(r)(state)
104
105def accepted(~S: Type, ~handle: Http.Request -> S -> IO(S & Http.Response),
106  got: Listener & Result<&1, &1, U32 & String, Socket>, state: S, +max: U32) -> IO(Listener & S):
107  (listener, result) = got
108  match result:
109    case Fail{err}:
110      IO.pure(Listener & S, (listener, state))
111    case Done{socket}:
112      do IO<Listener & S>:
113        request : Socket & Maybe<&2, Http.Request> <- read(socket, max)
114        next : S <- answer(~S, ~handle, request, state)
115        return (listener, next)
116
117def accepted.socket(~S: Type, ~reply: Socket -> Http.Request -> S -> IO(S),
118  got: Listener & Result<&1, &1, U32 & String, Socket>, state: S, +max: U32) -> IO(Listener & S):
119  (listener, result) = got
120  match result:
121    case Fail{err}:
122      IO.pure(Listener & S, (listener, state))
123    case Done{socket}:
124      do IO<Listener & S>:
125        request : Socket & Maybe<&2, Http.Request> <- read(socket, max)
126        next : S <- answer.socket(~S, ~reply, request, state)
127        return (listener, next)
128
129# Accepts one connection, reads its request (up to max bytes), answers it
130# with handle(request)(state) and closes it; a request that never parses
131# gets a 400. A failed accept leaves the state as it was.
132def step(~S: Type, ~handle: Http.Request -> S -> IO(S & Http.Response),
133  listener: Listener, state: S, +max: U32) -> IO(Listener & S):
134  do IO<Listener & S>:
135    got : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(listener)
136    accepted(~S, ~handle, got, state, max)
137
138# As step, but reply(socket)(request)(state) answers on the socket itself
139# and must close it: for bodies the app streams through its own effect.
140def step.socket(~S: Type, ~reply: Socket -> Http.Request -> S -> IO(S),
141  listener: Listener, state: S, +max: U32) -> IO(Listener & S):
142  do IO<Listener & S>:
143    got : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(listener)
144    accepted.socket(~S, ~reply, got, state, max)
145
146def loop.next(-S: Type, got: Listener & S, next: Listener -> S -> IO(Listener & S)) -> IO(Listener & S):
147  (listener, state) = got
148  next(listener)(state)
149
150# Serves n connections, then hands back the listener and the state.
151def serve.for(~S: Type, ~handle: Http.Request -> S -> IO(S & Http.Response),
152  n: Nat, listener: Listener, state: S, +max: U32) -> IO(Listener & S):
153  match n:
154    case 0n:
155      IO.pure(Listener & S, (listener, state))
156    case 1n+p:
157      do IO<Listener & S>:
158        got : Listener & S <- step(~S, ~handle, listener, state, max)
159        loop.next(S, got, l => s => serve.for(~S, ~handle, p, l, s, max))
160
161def serve.socket.for(~S: Type, ~reply: Socket -> Http.Request -> S -> IO(S),
162  n: Nat, listener: Listener, state: S, +max: U32) -> IO(Listener & S):
163  match n:
164    case 0n:
165      IO.pure(Listener & S, (listener, state))
166    case 1n+p:
167      do IO<Listener & S>:
168        got : Listener & S <- step.socket(~S, ~reply, listener, state, max)
169        loop.next(S, got, l => s => serve.socket.for(~S, ~reply, p, l, s, max))
170
171# Serves connections forever, one at a time (unsafe: it never ends).
172def serve?(~S: Type, ~handle: Http.Request -> S -> IO(S & Http.Response),
173  listener: Listener, state: S, +max: U32) -> IO(Listener & S):
174  do IO<Listener & S>:
175    got : Listener & S <- step(~S, ~handle, listener, state, max)
176    loop.next(S, got, l => s => serve(~S, ~handle, l, s, max))
177
178def serve.socket?(~S: Type, ~reply: Socket -> Http.Request -> S -> IO(S),
179  listener: Listener, state: S, +max: U32) -> IO(Listener & S):
180  do IO<Listener & S>:
181    got : Listener & S <- step.socket(~S, ~reply, listener, state, max)
182    loop.next(S, got, l => s => serve.socket(~S, ~reply, l, s, max))