Initial split of %light into %http-server and %http-client

This commit is contained in:
Elliot Glaysher 2019-02-08 15:03:46 -08:00
parent 019cb0f8e7
commit 253ef31531
10 changed files with 331 additions and 412 deletions

View File

@ -7,7 +7,7 @@
+$ card
$% [%connect wire [(unit @t) (list @t)] %server]
[%wait wire @da]
[%http-response =raw-http-response:light]
[%http-response =http-event:http]
[%diff %json json]
==
--
@ -92,8 +92,8 @@
::
++ require-authorization
|* [=bone move=mold this=*]
|= handler=$-(inbound-request:light (quip move _this))
|= =inbound-request:light
|= handler=$-(inbound-request:http-server (quip move _this))
|= =inbound-request:http-server
^- (quip move _this)
::
?: authenticated.inbound-request
@ -103,8 +103,8 @@
^- (list move)
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.http-request.inbound-request)}"
[bone [%http-response %start 307 ['location' redirect]~ ~ %.y]]~
"/~/login?redirect={(trip url.request.inbound-request)}"
[bone [%http-response %start [307 ['location' redirect]~] ~ %.y]]~
--
|%
::
@ -128,7 +128,7 @@
:: alerts us that we were bound. we need this because the vane calls back.
::
++ bound
|= [wir=wire success=? binding=binding:light]
|= [wir=wire success=? binding=binding:http-server]
~& [%bound success]
[~ this]
::
@ -160,10 +160,10 @@
::
++ poke-handle-http-request
%- (require-authorization ost.bow move this)
|= =inbound-request:light
|= =inbound-request:http-server
^- (quip move _this)
::
=+ request-line=(parse-request-line url.http-request.inbound-request)
=+ request-line=(parse-request-line url.request.inbound-request)
~& [%request-line request-line]
=/ name=@t
=+ back-path=(flop site.request-line)
@ -176,7 +176,7 @@
:~ ^- move
:- ost.bow
:* %http-response
[%start 200 ['content-type' 'application/javascript']~ [~ hello-js] %.y]
[%start [200 ['content-type' 'application/javascript']~] [~ hello-js] %.y]
==
==
::
@ -184,13 +184,13 @@
:~ ^- move
:- ost.bow
:* %http-response
[%start 200 ['content-type' 'text/html']~ [~ (hello name)] %.y]
[%start [200 ['content-type' 'text/html']~] [~ (hello name)] %.y]
==
==
:: +poke-handle-http-cancel: received when a connection was killed
::
++ poke-handle-http-cancel
|= =inbound-request:light
|= =inbound-request:http-server
^- (quip move _this)
:: the only long lived connections we keep state about are the stream ones.
::

View File

@ -40,7 +40,7 @@
{$flog wire flog:dill} ::
[%mint wire our=ship p=ship q=safe:rights:jael]
{$nuke wire ship} ::
[%serve wire binding:light generator:light]
[%serve wire binding:http-server generator:http-server]
{$poke wire dock pear} ::
== ::
++ move (pair bone card) :: user-level move
@ -149,6 +149,7 @@
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
~& [%poke-reload-desk-nam way fil]
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
:: +poke-reset: send %vega to reboot kernel
::
@ -185,11 +186,11 @@
(emit %flog ~ %text "woot: {<[way cop]>}")
::
++ poke-serve
|= [=binding:light =generator:light] =< abet
|= [=binding:http-server =generator:http-server] =< abet
(emit %serve /helm/serv binding generator)
::
++ take-bound
|= [wir=wire success=? binding=binding:light] =< abet
|= [wir=wire success=? binding=binding:http-server] =< abet
(emit %flog ~ %text "bound: {<success>}")
::
++ poke-tlon-init-stream

View File

@ -17,9 +17,9 @@
:: sys/vane/http-client: http client
::
[%http-client /vane/http-client]
:: sys/vane/light: new web
:: sys/vane/http-server: http server
::
[%l /vane/light]
[%http-server /vane/http-server]
:: sys/vane/ames: network
::
[%a /vane/ames]

View File

@ -1,3 +1,4 @@
!:
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: Postface ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
@ -164,7 +165,7 @@
=+ syg=(slym rev arg)
:: update the vane itself
::
:: We don't cache the +slap/+slam types because they're only used once
:: We don't cache the n+slap/+slam types because they're only used once
:: right here; they'll never be used again.
::
=. vase.vane
@ -243,9 +244,14 @@
++ slur-e ~/(%slur-e |=({gat/vase hil/mill} =+(%e (slur gat hil))))
++ slur-f ~/(%slur-f |=({gat/vase hil/mill} =+(%f (slur gat hil))))
++ slur-g ~/(%slur-g |=({gat/vase hil/mill} =+(%g (slur gat hil))))
++ slur-l ~/(%slur-l |=({gat/vase hil/mill} =+(%l (slur gat hil))))
++ slur-j ~/(%slur-j |=({gat/vase hil/mill} =+(%j (slur gat hil))))
++ slur-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil))))
++ slur-http-server
~/ %slur-http-server
|=({gat/vase hil/mill} =+(%http-server (slur gat hil)))
++ slur-http-client
~/ %slur-http-client
|=({gat/vase hil/mill} =+(%http-client (slur gat hil)))
::
++ slur-pro :: profiling slur
~/ %slur-pro
@ -258,8 +264,10 @@
$e (slur-e gat hil)
$f (slur-f gat hil)
$g (slur-g gat hil)
$l (slur-l gat hil)
$j (slur-j gat hil)
::
%http-client (slur-http-client gat hil)
%http-server (slur-http-server gat hil)
==
::
++ song :: reduce metacard
@ -463,7 +471,8 @@
{@ $newt *} %a
{@ $sync *} %c
{@ $term *} %d
{@ $http *} %l
:: TODO: %http-server in the interface.
{@ $http-server *} %http-server
{@ $behn *} %b
==
::
@ -501,6 +510,7 @@
|- ^- {{p/(list ovum) q/(list muse)} _vanes}
?~ naf [[~ ~] ~]
?. =(lal label.i.naf)
~| [%lal lal label.i.naf]
=+ tuh=$(naf t.naf)
[-.tuh [+<.tuh [i.naf +>.tuh]]]
::

View File

@ -821,7 +821,7 @@
$send (ap-move-send -.q.vax cav)
$quit (ap-move-quit -.q.vax cav)
::
$connect (ap-move-connect -.q.vax cav)
:: $connect (ap-move-connect -.q.vax cav)
$http-response (ap-move-http-response -.q.vax cav)
==
::
@ -843,21 +843,6 @@
=^ tel vel (~(slot wa vel) 3 pec)
:_(+>.$ [%& sto %give %diff `cage`[-.q.pec tel]])
::
++ ap-move-connect
|= {sto/bone vax/vase}
^- {(each cove tang) _+>}
=+ pux=((soft path) -.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
~& [%bad-path pux]
:_(+>.$ [%| (ap-suck "pass: malformed path")])
=^ tel vel (~(slot wa vel) 3 vax)
:_ +>.$
~& [%ap-move-connect sto]
:^ %& sto %pass
:- [(scot %p q.q.pry) %inn u.pux]
[%meta %l (slop (ap-term %tas %http-server) (slop (ap-term %tas %connect) tel))]
::
++ ap-move-http-response
|= [sto=bone vax=vase]
^- [(each cove tang) _+>]
@ -1329,7 +1314,8 @@
$well `%e
$wind `%j
$wipe `%f
%http-server `%l
$serve `%http-server
$connect `%http-server
==
--
--

View File

@ -2,7 +2,7 @@
:: lighter than eyre
::
|= pit=vase
=, light
=, http-server
:: internal data structures
::
=> =~
@ -19,7 +19,7 @@
::
card=(wind note gift:able)
==
:: +note: private request from light to another vane
:: +note: private request from http-server to another vane
::
+$ note
$% :: %b: to behn
@ -74,62 +74,13 @@
::
|%
++ axle
$: :: date: date at which light's state was updated to this data structure
$: :: date: date at which http-server's state was updated to this data structure
::
date=%~2019.1.7
:: client-state: state of outbound requests
::
client-state=state:client
:: server-state: state of inbound requests
::
=server-state
==
:: +client: light as an http client
::
++ client
|%
:: +state:client: state relating to open outbound HTTP connections
::
+$ state
$: :: next-id: monotonically increasing id number for the next connection
::
next-id=@ud
:: connection-by-id: open connections to the
::
connection-by-id=(map @ud [=duct =in-progress-http-request])
:: outbound-duct: the duct to send outbound requests on
::
outbound-duct=duct
==
:: +in-progress-http-request: state around an outbound http
::
+$ in-progress-http-request
$: :: remaining-redirects: http limit of number of redirects before error
::
remaining-redirects=@ud
:: remaining-retries: number of times to retry the request
::
remaining-retries=@ud
:: response-headers: the response headers from the %start packet
::
:: We send the response headers with each %http-progress, so we must
:: save them.
::
response-headers=(unit response-header:http)
:: chunks: a list of partial results returned from unix
::
:: This list of octs must be flopped before it is composed as the
:: final response, as we want to be able to quickly insert.
::
chunks=(list octs)
:: bytes-read: the sum of the size of the :chunks
::
bytes-read=@ud
:: expected-size: the expected content-length of the http request
::
expected-size=(unit @ud)
==
--
:: +server-state: state relating to open inbound HTTP connections
::
+$ server-state
@ -1337,7 +1288,7 @@
^- (list move)
:_ moves
:+ p.state.channel %give
^- gift:able:light
^- gift:able:http-server
:* %response %continue
::
^= data
@ -1418,7 +1369,7 @@
==
:: +handle-response: check a response for correctness and send to earth
::
:: All outbound responses including %light generated responses need to go
:: All outbound responses including %http-server generated responses need to go
:: through this interface because we want to have one centralized place
:: where we perform logging and state cleanup for connections that we're
:: done with.
@ -1621,11 +1572,11 @@
|= [our=ship now=@da eny=@uvJ scry-gate=sley]
:: allow jets to be registered within this core
::
~% %light ..is ~
~% %http-server ..is ~
|%
++ call
|= [=duct type=* wrapped-task=(hobo task:able)]
^- [(list move) _light-gate]
^- [(list move) _http-server-gate]
::
=/ task=task:able
?. ?=(%soft -.wrapped-task)
@ -1641,16 +1592,11 @@
:~ [[~ /~/login] duct [%authentication ~]]
[[~ /~/channel] duct [%channel ~]]
==
[~ light-gate]
[~ http-server-gate]
:: %born: new unix process
?: ?=(%born -.task)
::
~& [%todo-handle-born p.task]
:: TODO: reset the next-id for client state here.
::
:: send requests on the duct passed in with born.
::
=. outbound-duct.client-state.ax duct
:: close previously open connections
::
:: When we have a new unix process, every outstanding open connection is
@ -1672,7 +1618,7 @@
::
$(closed-connections (weld moves closed-connections), connections t.connections)
::
:_ light-gate
:_ http-server-gate
;: weld
:: hand back default configuration for now
::
@ -1692,60 +1638,36 @@
::
~& [%todo-live task]
::
[~ light-gate]
[~ http-server-gate]
::
%request
=^ moves server-state.ax (request:server +.task)
[moves light-gate]
[moves http-server-gate]
::
%cancel-request
=^ moves server-state.ax cancel-request:server
[moves light-gate]
[moves http-server-gate]
::
%connect
=^ moves server-state.ax
%+ add-binding:server binding.task
[%app app.task]
[moves light-gate]
[moves http-server-gate]
::
%serve
=^ moves server-state.ax
%+ add-binding:server binding.task
[%gen generator.task]
[moves light-gate]
[moves http-server-gate]
::
%disconnect
=. server-state.ax (remove-binding:server binding.task)
[~ light-gate]
[~ http-server-gate]
==
:: ::
:: ::
:: ::
:: %http-client
:: :: TODO: Move me.
:: ::
:: =/ event-args [[our eny duct now scry-gate] client-state.ax]
:: [~ light-gate]
:: =/ client (per-client-event event-args)
:: ?- -.client-task.task
:: ::
:: %request
:: =^ moves client-state.ax (request:client +.client-task.task)
:: [moves light-gate]
:: ::
:: %cancel-request
:: ~& %todo-cancel-request
:: [~ light-gate]
:: ::
:: %receive
:: =^ moves client-state.ax (receive:client +.client-task.task)
:: [moves light-gate]
:: ==
::==
::
++ take
|= [=wire =duct wrapped-sign=(hypo sign)]
^- [(list move) _light-gate]
^- [(list move) _http-server-gate]
:: unwrap :sign, ignoring unneeded +type in :p.wrapped-sign
::
=/ =sign q.wrapped-sign
@ -1753,7 +1675,7 @@
::
?> ?=([@ *] wire)
::
|^ ^- [(list move) _light-gate]
|^ ^- [(list move) _http-server-gate]
::
?+ i.wire
~|([%bad-take-wire wire] !!)
@ -1769,12 +1691,12 @@
:: entirely normal to get things other than http-response calls, but we
:: don't care.
::
[~ light-gate]
[~ http-server-gate]
::
=/ event-args [[our eny duct now scry-gate] server-state.ax]
=/ handle-response handle-response:(per-server-event event-args)
=^ moves server-state.ax (handle-response http-event.p.sign)
[moves light-gate]
[moves http-server-gate]
::
++ run-build
::
@ -1783,7 +1705,7 @@
=/ event-args [[our eny duct now scry-gate] server-state.ax]
=/ handle-ford-response handle-ford-response:(per-server-event event-args)
=^ moves server-state.ax (handle-ford-response result.sign)
[moves light-gate]
[moves http-server-gate]
::
++ channel
::
@ -1800,10 +1722,10 @@
on-channel-timeout:by-channel:(per-server-event event-args)
=^ moves server-state.ax
(on-channel-timeout i.t.t.wire)
[moves light-gate]
::
[moves http-server-gate]
:: %wake
:: [~ move
::
:: TODO: wake me up inside
::
?(%poke %subscription)
?> ?=([%g %unto *] sign)
@ -1813,11 +1735,11 @@
:: ~& [%gall-response sign]
=^ moves server-state.ax
(on-gall-response i.t.t.wire `@ud`(slav %ud i.t.t.t.wire) p.sign)
[moves light-gate]
[moves http-server-gate]
==
--
::
++ light-gate ..$
++ http-server-gate ..$
:: +load: migrate old state to new state (called on vane reload)
::
++ load

View File

@ -728,7 +728,7 @@
^- (list move)
:~ [hen %pass /(scot %p our)/init %b %wait +(now)]
[hen %give %init our]
[hen %slip %l %init our]
[hen %slip %http-server %init our]
[hen %slip %d %init our]
[hen %slip %g %init our]
[hen %slip %c %init our]
@ -777,7 +777,7 @@
%+ weld moz
^- (list move)
:~ [hen %give %init our]
[hen %slip %l %init our]
[hen %slip %http-server %init our]
[hen %slip %d %init our]
[hen %slip %g %init our]
[hen %slip %c %init our]

View File

@ -2173,7 +2173,7 @@
::
::::
::
++ light ^?
++ http-server ^?
|%
++ able
|%
@ -7383,7 +7383,7 @@
{$f task:able:ford}
{$g task:able:gall}
{$j task:able:jael}
{$l task:able:light}
[%http-server task:able:http-server]
{@tas $meta vase}
==
++ sign-arvo :: in result $<-
@ -7395,7 +7395,7 @@
{$f gift:able:ford}
{$g gift:able:gall}
{$j gift:able:jael}
{%l gift:able:light}
[%http-server gift:able:http-server]
==
::
++ unix-task :: input from unix

File diff suppressed because it is too large Load Diff

View File

@ -30,7 +30,7 @@
[hen %slip %c %init ~nul]
[hen %slip %g %init ~nul]
[hen %slip %d %init ~nul]
[hen %slip %l %init ~nul]
[hen %slip %http-server %init ~nul]
[hen %give %init ~nul]
[hen %pass /~nul/init %b %wait +(~1234.5.6)]
== ==