mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 01:52:42 +03:00
Data types, basic tests, and a router.
This commit is contained in:
parent
78eb61cc09
commit
36841a5280
438
sys/vane/light.hoon
Normal file
438
sys/vane/light.hoon
Normal 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
211
tests/sys/vane/light.hoon
Normal 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]
|
||||
--
|
Loading…
Reference in New Issue
Block a user