mall, eyre: refactor server apps to be stateless

This commit is contained in:
Philip Monk 2019-11-13 00:38:35 -08:00
parent 1d1e9c0e16
commit 4a6e98a558
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
6 changed files with 51 additions and 234 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:0bd369e7b1df2cb3c806706d3d20774b9441e957cb5f29cd059d931b87baaecc
size 9231363
oid sha256:20c324d5930169f4d39d4d7d91dd5c90156cc360c4e1fe5851b96a2d751561b5
size 9015417

View File

@ -9,7 +9,6 @@
=, format
::
%+ verb &
%- http-handler
^- agent:mall
|_ =bowl:mall
+* this .
@ -28,11 +27,11 @@
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall _this)
?. ?=(%http-request mark)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([=path =inbound-request:eyre] vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
:_ this
%+ give-simple-payload:app path
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
|= =inbound-request:eyre
=/ request-line (parse-request-line url.request.inbound-request)
@ -52,6 +51,8 @@
++ on-watch
|= =path
^- (quip card:agent:mall _this)
?: ?=([%http-response *] path)
`this
?. =(/tile path)
(on-watch:def path)
[[%give %fact ~ %json !>(*json)]~ this]

View File

@ -1,87 +0,0 @@
:: delay incoming http requests until eyre is subscribed to responses.
::
|= =agent:mall
=| state=[count=@ud map=(map app-id=@ud inbound-request:eyre)]
^- agent:mall
|_ =bowl:mall
+* this .
ag ~(. agent bowl)
::
++ on-init
^- (quip card:agent:mall agent:mall)
=^ cards agent on-init:ag
[cards this]
::
++ on-save
^- vase
!>([on-save:ag state])
::
++ on-load
|= old-state=vase
^- (quip card:agent:mall agent:mall)
=^ old state !<([vase _state] old-state)
=^ cards agent (on-load:ag old)
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall agent:mall)
?. ?=(%handle-http-request mark)
=^ cards agent (on-poke:ag mark vase)
[cards this]
=+ !<([eyre-id=@ud =inbound-request:eyre] vase)
=/ app-id count.state
=: count.state +(count.state)
map.state (~(put by map.state) app-id inbound-request)
==
:_ this :_ ~
[%pass / %arvo %e %start-watching eyre-id app-id]
::
++ on-watch
|= =path
^- (quip card:agent:mall agent:mall)
?. ?=([%http-response @ ~] path)
=^ cards agent (on-watch:ag path)
[cards this]
=/ app-id (slav %ud i.t.path)
=/ request (~(get by map.state) app-id)
=. map.state (~(del by map.state) app-id)
?~ request
:_ this
^- (list card:agent:mall)
:~ [%give %fact `path %http-response-cancel !>(~)]
[%give %kick `path ~]
==
=^ cards agent
(on-poke:ag %http-request !>([path u.request]))
[cards this]
::
++ on-leave
|= =path
^- (quip card:agent:mall agent:mall)
=^ cards agent (on-leave:ag path)
[cards this]
::
++ on-peek
|= =path
^- (unit (unit cage))
(on-peek:ag path)
::
++ on-agent
|= [=wire =sign:agent:mall]
^- (quip card:agent:mall agent:mall)
=^ cards agent (on-agent:ag wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:mall agent:mall)
=^ cards agent (on-arvo:ag wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:mall agent:mall)
=^ cards agent (on-fail:ag term tang)
[cards this]
--

View File

@ -1,4 +1,3 @@
/+ http-handler
=, eyre
|%
::
@ -41,65 +40,16 @@
[[307 ['location' redirect]~] ~]
::
++ give-simple-payload
|= [=path =simple-payload:http]
|= [eyre-id=@ta =simple-payload:http]
^- (list card:agent:mall)
:~ [%give %fact `path %http-response-header !>(response-header.simple-payload)]
[%give %fact `path %http-response-data !>(data.simple-payload)]
[%give %kick `path ~]
=/ header-cage
[%http-response-header !>(response-header.simple-payload)]
=/ data-cage
[%http-response-data !>(data.simple-payload)]
:~ [%give %fact `/http-response/[eyre-id] header-cage]
[%give %fact `/http-response/[eyre-id] data-cage]
[%give %kick `/http-response/[eyre-id] ~]
==
::
++ html-response
|= oct-html=octs
^- http-event:http
[%start [200 ['content-type' 'text/html']~] [~ oct-html] %.y]
::
++ js-response
|= oct-js=octs
^- http-event:http
[%start [200 ['content-type' 'text/javascript']~] [~ oct-js] %.y]
::
++ json-response
|= oct-js=octs
^- http-event:http
[%start [200 ['content-type' 'application/json']~] [~ oct-js] %.y]
::
++ css-response
|= oct-css=octs
^- http-event:http
[%start [200 ['content-type' 'text/css']~] [~ oct-css] %.y]
::
++ manx-response
|= man=manx
^- http-event:http
[%start [200 ['content-type' 'text/html']~] [~ (manx-to-octs man)] %.y]
::
++ png-response
|= oct-png=octs
^- http-event:http
[%start [200 ['content-type' 'image/png']~] [~ oct-png] %.y]
::
++ woff2-response
|= oct-woff=octs
^- http-event:http
[%start [200 ['content-type' 'font/woff2']~] [~ oct-woff] %.y]
::
++ not-found
^- http-event:http
[%start [404 ~] ~ %.y]
::
++ login-redirect
|= =inbound-request:eyre
^- http-event:http
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.request.inbound-request)}"
[%start [307 ['location' redirect]~] ~ %.y]
::
++ redirect
|= redirect=cord
^- http-event:http
[%start [307 ['location' redirect]~] ~ %.y]
::
--
++ gen
|%
@ -124,6 +74,21 @@
^- simple-payload:http
[[200 ['content-type' 'text/css']~] `octs]
::
++ manx-response
|= man=manx
^- simple-payload:http
[[200 ['content-type' 'text/html']~] `(manx-to-octs man)]
::
++ png-response
|= =octs
^- simple-payload:http
[[200 ['content-type' 'image/png']~] `octs]
::
++ woff2-response
|= =octs
^- simple-payload:http
[[200 ['content-type' 'font/woff2']~] `octs]
::
++ not-found
^- simple-payload:http
[[404 ~] ~]
@ -140,6 +105,5 @@
|= redirect=cord
^- simple-payload:http
[[307 ['location' redirect]~] ~]
::
--
--

View File

@ -102,11 +102,6 @@
:: the :binding into a (map (unit @t) (trie knot =action)).
::
bindings=(list [=binding =duct =action])
:: starting: new http connections waiting for app to send %start-watching
::
:: Ducts should be keys of connections.
::
starting=[count=@ud map=(map eyre-id=@ud [=duct app=term])]
:: connections: open http connections not fully complete
::
connections=(map duct outstanding-connection)
@ -821,11 +816,7 @@
^- [(list move) server-state]
::
=/ act [%app app=%lens]
=/ eyre-id count.starting.state
=: count.starting.state +(count.starting.state)
map.starting.state
(~(put by map.starting.state) eyre-id [duct app.act])
==
=/ eyre-id (cat 3 'eyre--' (scot %uv eny))
::
=/ connection=outstanding-connection
[act [& secure address request] ~ 0]
@ -834,16 +825,7 @@
(~(put by connections.state) duct connection)
::
:_ state
:_ ~
:^ duct %pass /run-app-request/[app.act]
^- note
:^ %m %deal [our our] :- app.act
::
^- task:agent:mall
:* %poke
%handle-http-request
!>([eyre-id inbound-request.connection])
==
(subscribe-to-app app.act eyre-id inbound-request.connection)
:: +request: starts handling an inbound http request
::
++ request
@ -877,26 +859,9 @@
[%$ %noun !>([authenticated request])]
::
%app
=/ eyre-id count.starting.state
=: count.starting.state +(count.starting.state)
map.starting.state
(~(put by map.starting.state) eyre-id [duct app.action])
==
::
=/ eyre-id (cat 3 'eyre--' (scot %uv eny))
:_ state
:_ ~
:^ duct %pass /run-app-request/[app.action]
^- note
:^ %m %deal [our our] :- app.action
:: todo: i don't entirely understand gall; there's a way to make a gall
:: use a %handle arm instead of a sub-%poke with the
:: %handle-http-request type.
::
^- task:agent:mall
:* %poke
%handle-http-request
!>([eyre-id inbound-request.connection])
==
(subscribe-to-app app.action eyre-id inbound-request.connection)
::
%authentication
(handle-request:authentication secure address request)
@ -908,22 +873,21 @@
%^ return-static-data-on-duct 404 'text/html'
(error-page 404 authenticated url.request ~)
==
:: +start-watching: start watching app for response
:: +subscribe-to-app: subscribe to app and poke it with request data
::
++ start-watching
|= [eyre-id=@ud app-id=@ud]
^- [(list move) server-state]
=/ start=(unit [duct=^duct app=term])
(~(get by map.starting.state) eyre-id)
?~ start
~& [%invalid-starting-connection eyre-id]
[~ state]
::
:_ state(map.starting (~(del by map.starting.state) eyre-id))
:_ ~
:* duct.u.start %pass /watch-response
%m %deal [our our] app.u.start
%watch /http-response/(scot %ud app-id)
++ subscribe-to-app
|= [app=term eyre-id=@ta =inbound-request:eyre]
^- (list move)
:~ :* duct %pass /watch-response
%m %deal [our our] app
%watch /http-response/[eyre-id]
==
::
:* duct %pass /run-app-request
%m %deal [our our] app
%poke %handle-http-request
!>([eyre-id inbound-request])
==
==
:: +cancel-request: handles a request being externally aborted
::
@ -946,14 +910,9 @@
%app
:_ state
:_ ~
:^ duct %pass /run-app-cancel/[app.action.u.connection]
^- note
:^ %m %deal [our our] :- app.action.u.connection
::
^- task:agent:mall
:* %poke
%handle-http-cancel
!>(inbound-request.u.connection)
:* duct %pass /watch-response
%m %deal [our our] app.action.u.connection
%leave ~
==
::
%authentication
@ -2146,10 +2105,6 @@
%request-local
=^ moves server-state.ax (request-local:server +.task)
[moves http-server-gate]
::
%start-watching
=^ moves server-state.ax (start-watching:server +.task)
[moves http-server-gate]
::
%cancel-request
=^ moves server-state.ax cancel-request:server
@ -2210,7 +2165,6 @@
::
%run-app-request run-app-request
%watch-response watch-response
%run-app-cancel run-app-cancel
%run-build run-build
%channel channel
%acme acme-ack
@ -2279,18 +2233,6 @@
(handle-response http-event)
[moves http-server-gate]
::
++ run-app-cancel
::
?> ?=([%m %unto *] sign)
::
:: we explicitly don't care about the return value of a
:: %handle-http-cancel. It is purely a notification and we don't care if
:: it succeeds or not. The user might not have implemented
:: +poke-handle-http-cancel or it might have crashed, but since it's a
:: notification, we don't don't care about its return value.
::
[~ http-server-gate]
::
++ run-build
::
?> ?=([%f %made *] sign)

View File

@ -922,9 +922,6 @@
:: starts handling an backdoor http request
::
[%request-local secure=? =address =request:http]
:: initiates a subscription to get response
::
[%start-watching our-id=@ud app-id=@ud]
:: cancels a previous request
::
[%cancel-request ~]