Data types, basic tests, and a router.

This commit is contained in:
Elliot Glaysher 2018-09-19 16:29:36 -07:00
parent 78eb61cc09
commit 36841a5280
2 changed files with 649 additions and 0 deletions

438
sys/vane/light.hoon Normal file
View File

@ -0,0 +1,438 @@
!:
:: lighter than eyre
::
|= pit=vase
:: internal data structures
::
=> =~
::
|%
--
:: TODO: this becomes the +eyre interface arm in zuse
::
|%
+| %vane-interface
++ able
|%
++ gift
$% :: http-response: response from urbit to earth
::
:: Urbit treats Earth's HTTP servers as pipes, where Urbit sends one or
:: more %http-response replies on the wire. The first of these will
:: always be a %start or an %error, and the last will always be %error
:: or will have :complete set to %.y to finish the connection.
::
:: Calculation of control headers such as 'Content-Length' or
:: 'Transfer-Encoding' are performed inside Urbit and sent to Vere.
::
$: %http-response
::
::
$% :: %start: the first packet in a response
::
$: %start
:: status: http status code
::
status-code=@ud
:: headers: http headers
::
headers=header-list
:: data: data to pass to the pipe
::
data=(unit octs)
:: whether this completes the request
::
complete=?
==
:: %continue: every subsequent packet
::
$: %continue
:: data: data to pass to the pipe
::
data=(unit octs)
:: complete: whether this completes the request
::
complete=?
==
:: %cancel: whether the connection should terminate unsuccessfully
::
[%cancel ~]
== ==
:: response to a %connect or %serve
::
:: :accepted is whether :binding was valid. Duplicate bindings are not allowed.
::
[%bound accepted=? =binding]
==
::
++ task
$% :: initializes ourselves with an identity
::
:: TODO: Remove this once we single home.
::
[%init our=@p]
:: starts handling an inbound http request
::
[%inbound-request secure=? =address =http-request]
:: connects a binding to an app
::
[%connect =binding app=term]
:: connects a binding to a generator
::
[%serve =binding generator=[=desk path=(list @t)] arguments=*]
:: disconnects a binding
::
:: This must be called with the same duct that made the binding in
:: the first place.
::
[%disconnect =binding]
==
--
::
+| %bindings
:: +binding: A rule to match a path.
::
:: A +binding is a system unique mapping for a path to match. A +binding
:: must be system unique because we don't want two handlers for a path;
:: what happens if there are two different actions for [~ /]?
::
+$ binding
$: :: site: the site to match.
::
:: A ~ will match the Urbit's identity site (your.urbit.org). Any
:: other value will match a domain literal.
::
site=(unit @t)
:: path: matches this prefix path
::
:: /~myapp will match /~myapp or /~myapp/longer/path
::
path=(list @t)
==
::
+| %http
:: +header-list: an ordered list of http headers
::
+$ header-list
(list [key=@t value=@t])
:: +http-method: exhaustive list of http verbs
::
+$ http-method
$? %'CONNECT'
%'DELETE'
%'GET'
%'HEAD'
%'OPTIONS'
%'POST'
%'PUT'
%'TRACE'
==
:: +http-request: a single http-request
::
+$ http-request
$: :: http-method:
::
=http-method
:: url: the url requested
::
:: The url is not escaped. There is no escape.
::
url=@t
:: header-list: headers to pass with this request
::
=header-list
:: body: optionally, data to send with this request
::
body=(unit octs)
==
:: +address: client IP address
::
+$ address
$% [%ipv4 @if]
[%ipv6 @is]
:: [%ames @p]
==
--
:: internal data structures that won't go in zuse
::
|%
+$ move
::
$: :: duct: request identifier
::
=duct
::
::
card=(wind note gift:able)
==
:: +note: private request from light to another vane
::
+$ note
$% :: %f: to ford
::
$: %f
::
::
$% [%build our=@p live=? schematic=schematic:ford]
== == ==
--
:: more structures
::
|%
++ axle
$: :: date: date at which light's state was updated to this data structure
::
date=%~2018.9.12
:: ship: the ship name.
::
:: TODO: Remove when we single home.
::
ship=(unit ship)
:: client-state: state of outbound requests
::
::=client-state
:: server-state: state of inbound requests
::
=server-state
==
:: +server-state: state relating to open inbound HTTP connections
::
+$ server-state
$: :: bindings: actions to dispatch to when a binding matches
::
:: Eyre is responsible for keeping its bindings sorted so that it
:: will trigger on the most specific binding first. Eyre should send
:: back an error response if an already bound binding exists.
::
:: TODO: It would be nice if we had a path trie. We could decompose
:: the :binding into a (map (unit @t) (trie knot =action)).
::
bindings=(list [=binding =duct =action])
==
:: +action: the action to take when a binding matches an incoming request
::
+$ action
$% :: dispatch to a generator
::
[%gen generator=[=desk path=(list @t)] args=*]
:: dispatch to an application
::
[%app app=term]
:: dispatch to a vane
::
:: Ted pointed out that we are planning for jael to start talking
:: to the web server and not going through an app.
::
::[%sys vane=term]
==
--
:: utilities
::
|%
:: +get-header: returns the value for :header, if it exists in :header-list
::
++ get-header
|= [header=@t =header-list]
^- (unit @t)
::
?~ header-list
~
::
?: =(key.i.header-list header)
`value.i.header-list
::
$(header-list t.header-list)
:: +per-server-event: per-event client core
::
++ per-server-event
|= [[our=@p =duct now=@da scry=sley] state=server-state]
|%
++ request
|= [secure=? =address =http-request]
^- [(list move) server-state]
::
=+ host=(get-header 'Host' header-list.http-request)
=+ action=(get-action-for-binding host url.http-request)
::
?~ action
~& %no-match-for-request
:: todo: return a reconstruction of the apache 404 page here
::
[~ state]
::
?- -.u.action
::
%gen
~& [%i-should-run-a-generator generator.u.action]
[~ state]
::
%app
~& [%i-should-run-an-app app.u.action]
[~ state]
==
:: +add-binding: conditionally add a pairing between binding and action
::
:: Adds =binding =action if there is no conflicting bindings.
::
++ add-binding
|= [=binding =action]
::
=/ to-search bindings.state
|-
^- [(list move) server-state]
?~ to-search
:- [duct %give %bound %.y binding]~
=. bindings.state
%+ sort [[binding duct action] bindings.state]
|= [[a=^binding *] [b=^binding *]]
::
?: =(site.a site.b)
(aor path.a path.b)
:: alphabetize based on site
::
(aor ?~(site.a '' u.site.a) ?~(site.b '' u.site.b))
state
::
?: =(binding binding.i.to-search)
:- [duct %give %bound %.n binding]~
state
::
$(to-search t.to-search)
:: +remove-binding: removes a binding if it exists and is owned by this duct
::
++ remove-binding
|= =binding
::
^- server-state
%_ state
bindings
%+ skip bindings.state
|= [item-binding=^binding item-duct=^duct =action]
^- ?
&(=(item-binding binding) =(item-duct duct))
==
::
:: Split string by parsing rule delimiter.
++ split
|* {str/tape delim/cord}
^- (list tape)
%+ fall
(rust str (more (jest delim) (star ;~(less (jest delim) next))))
[str ~]
:: +get-action-for-binding: finds an action for an incoming web request
::
++ get-action-for-binding
|= [raw-host=(unit @t) url=@t]
^- (unit action)
:: process :raw-host
::
:: If we are missing a 'Host:' header, if that header is a raw IP
:: address, or if the 'Host:' header refers to [our].urbit.org, we want
:: to return ~ which is the binding for our Urbit identity.
::
:: Otherwise, return the site given.
::
=/ host=(unit @t)
?~ raw-host
~
:: TODO: Check IP addresses. I can't just check the
:: `\d{0-3}\.\d{0-3}...` regex here.
::
:: render our as a tape, and cut off the sig in front.
::
=/ with-sig=tape (scow %p our)
?> ?=(^ with-sig)
?: =(u.raw-host (crip t.with-sig))
:: [our].urbit.org is the default site
::
~
::
raw-host
:: url is the raw thing passed over the 'Request-Line'.
::
:: We need to handle both the form 'http://one.com/two/three' and
:: '/two/three', but we're punting for now and just doing a split on
:: '/'.
::
=/ parsed-url=(list @t)
(turn (split (trip url) '/') crip)
::
=/ bindings bindings.state
|-
::
?~ bindings
~
::
?: ?& =(site.binding.i.bindings host)
=(`0 (find path.binding.i.bindings parsed-url))
==
`action.i.bindings
::
$(bindings t.bindings)
--
--
:: end the =~
::
. ==
:: begin with a default +axle as a blank slate
::
=| ax=axle
:: a vane is activated with current date, entropy, and a namespace function
::
|= [now=@da eny=@ scry-gate=sley]
:: allow jets to be registered within this core
::
~% %light ..is ~
|%
++ call
|= [=duct type=* wrapped-task=(hobo task:able)]
^- [p=(list move) q=_light-gate]
::
=/ task=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
((hard task:able) p.wrapped-task)
::
?- -.task
:: %init: tells us what our ship name is
::
%init
::
=. ship.ax [~ our.task]
[~ light-gate]
::
:: %inbound-request: handles an inbound http request
::
%inbound-request
=/ event-args [[(need ship.ax) duct now scry-gate] server-state.ax]
=/ request request:(per-server-event event-args)
=^ moves server-state.ax
(request +.task)
[moves light-gate]
::
:: %connect / %serve
::
?(%connect %serve)
=/ event-args [[(need ship.ax) duct now scry-gate] server-state.ax]
=/ add-binding add-binding:(per-server-event event-args)
=^ moves server-state.ax
%+ add-binding binding.task
?- -.task
%connect [%app app.task]
%serve [%gen generator.task arguments.task]
==
[moves light-gate]
::
:: %disconnect
::
%disconnect
=/ event-args [[(need ship.ax) duct now scry-gate] server-state.ax]
=/ remove-binding remove-binding:(per-server-event event-args)
=. server-state.ax (remove-binding binding.task)
[~ light-gate]
==
::
++ light-gate ..$
--

211
tests/sys/vane/light.hoon Normal file
View File

@ -0,0 +1,211 @@
/+ *test
::
/= light-raw /: /===/sys/vane/light /!noun/
::
!:
::
=/ test-pit=vase !>(..zuse)
=/ light-gate (light-raw test-pit)
::
|%
++ test-init
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/init] ~ [%init ~nul]]
expected-moves=~
==
::
results1
::
++ test-duplicate-bindings
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/init] ~ [%init ~nul]]
expected-moves=~
==
:: app1 binds successfully
::
=^ results2 light-gate
%- light-call :*
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app2 tries to bind to the same path and fails
::
=^ results3 light-gate
%- light-call :*
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.n [~ /]]~
==
::
;: weld
results1
results2
results3
==
::
++ test-remove-binding
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/init] ~ [%init ~nul]]
expected-moves=~
==
:: app1 binds successfully
::
=^ results2 light-gate
%- light-call :*
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app1 unbinds
::
=^ results3 light-gate
%- light-call :*
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app1] ~ [%disconnect [~ /]]]
expected-moves=~
==
:: app2 binds successfully
::
=^ results4 light-gate
%- light-call :*
light-gate
now=~1111.1.4
scry=*sley
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.y [~ /]]~
==
::
;: weld
results1
results2
results3
results4
==
::
++ test-cant-remove-other-ducts-binding
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/init] ~ [%init ~nul]]
expected-moves=~
==
:: app1 binds successfully
::
=^ results2 light-gate
%- light-call :*
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app2 tries to steal the binding by disconnecting the path
::
=^ results3 light-gate
%- light-call :*
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app2] ~ [%disconnect [~ /]]]
expected-moves=~
==
:: app2 doesn't bind successfully because it couldn't remove app1's binding
::
=^ results4 light-gate
%- light-call :*
light-gate
now=~1111.1.4
scry=*sley
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.n [~ /]]~
==
::
;: weld
results1
results2
results3
results4
==
::
++ test-basic-request
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/init] ~ [%init ~nul]]
expected-moves=~
==
:: app1 binds successfully
::
=^ results2 light-gate
%- light-call :*
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
::
::
=^ results3 light-gate
%- light-call :*
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/http-blah] ~ [%inbound-request %.n [%ipv4 .192.168.1.1]]]
expectec-moves=~
==
;: weld
results1
results2
results3
==
::
++ light-call
|= $: light-gate=_light-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:light-gate)]
expected-moves=(list move:light-gate)
==
^- [tang _light-gate]
::
=/ light-core (light-gate now=now eny=0xdead.beef scry=scry)
::
=^ moves light-gate (call:light-core call-args)
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output light-gate]
--