ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-24 10:33:22 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'ota-ford-fusion' into ted/kiln-fusion

Browse Source
This commit is contained in:
Ted Blackman 2020-06-17 02:37:45 -04:00
commit bcf79e38a1
15 changed files with 854 additions and 805 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/ISSUE_TEMPLATE/os1-bug-report.md vendored
View File

@ -3,7 +3,7 @@ name: OS1 Bug report
about: 'Use this template to file a bug for any OS1 app: Chat, Publish, Links, Groups,
Weather or Clock'
title: ''
labels: OS1
labels: landscape
assignees: ''
---

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:19cd17b12f29d397465a308361c0eddc32ec8fafaf354ea7a4bb396774c3c650
size 13014936
oid sha256:688a6812958f5328ce0409b9808cb5f3479e3d01eaf467d97e0dca54902a749b
size 12994298

39
pkg/arvo/app/chat-hook.hoon
View File

@ -14,11 +14,17 @@
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-2
$: %2
state-base
==
::
+$ state-1
$: %1
loaded-cards=(list card)
loaded-cards=*
state-base
==
+$ state-0 [%0 state-base]
@ -39,7 +45,7 @@
$% [%chat-update update:store]
==
--
=| state-1
=| state-2
=* state -
::
%- agent:dbug
@ -66,28 +72,30 @@
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
=^ moves state
^- (quip card state-2)
?: ?=(%2 -.old)
^- (quip card state-2)
`old
::
?: ?=(%1 -.old)
:_ this(state old)
^- (quip card state-2)
:_ [%2 +>.old]
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
^- (quip card state-2)
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
=/ upgraded-state
%* . *state-1
synced synced
invite-created invite-created
allow-history allow-history
loaded-cards
:_ [%2 +.old]
%- zing
^- (list (list card))
%+ turn ~(tap in keys) generate-cards
==
[loaded-cards.upgraded-state this(state upgraded-state)]
(turn ~(tap in keys) generate-cards)
[moves this]
::
++ generate-cards
|= old-chat=path
@ -233,10 +241,7 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun
?: =(%store-load q.vase)
[loaded-cards.state state(loaded-cards ~)]
[~ state]
%noun [~ state]
::
%chat-hook-action
(poke-chat-hook-action:cc !<(action:hook vase))
@ -457,7 +462,7 @@
(chats-of-group pax)
|= chat=path
^- (list card)
=/ owner (~(get by synced) chat)
=/ owner (~(get by synced.state) chat)
?~ owner ~
?. =(u.owner our.bol) ~
%- zing

20
pkg/arvo/app/goad.hoon
View File

@ -11,9 +11,7 @@
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
++ on-init on-init:def
++ on-save on-save:def
++ on-load on-load:def
::
++ on-poke
|= [=mark =vase]
?: ?=([%noun * %go] +<)
@ -22,10 +20,18 @@
[(goad &) this]
(on-poke:def mark vase)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo
|= [wir=wire sin=sign-arvo]
?+ wir (on-arvo:def wir sin)
[%clay ~] `this
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-init on-init:def
++ on-leave on-leave:def
++ on-load on-load:def
++ on-peek on-peek:def
++ on-save on-save:def
++ on-watch on-watch:def
--

18
pkg/arvo/app/publish.hoon
View File

@ -1,12 +1,12 @@
/- *publish,
/- *group-store,
/- *group-hook,
/- *permission-hook,
/- *permission-group-hook,
/- *permission-store,
/- *invite-store,
/- *metadata-store,
/- *metadata-hook,
/- *publish
/- *group-store
/- *group-hook
/- *permission-hook
/- *permission-group-hook
/- *permission-store
/- *invite-store
/- *metadata-store
/- *metadata-hook
/- *rw-security
/+ *server, *publish, cram, default-agent, dbug
::

28
pkg/arvo/sys/arvo.hoon
View File

@ -561,6 +561,8 @@
van=(map term vane)
==
+* this .
++ plot run.nub
++ then |=(paz=(list plan) this(run (weld run paz)))
++ abed |=(nib=debt this(nub nib))
:: +abet: finalize loop
::
@ -752,7 +754,7 @@
%+ turn von
=/ bem=beam [[our %home da+now] /whey]
|= [lal=@tas =vane]
=/ met (need (need (peek ** ~ lal bem)))
=/ met (need (need (peek ** ~ (rsh 3 5 lal) bem)))
lal^|+;;((list mass) q.q.met)
::
:+ %caches %|
@ -1059,7 +1061,13 @@
ram
~| ram+ram
=| nub=debt:le:part
[%345 nub(out ;;((list ovum) ram))]
=/ =plan:le:part
:- [%$ ~]
%+ turn ;;((list ovum) ram)
|= ovo=ovum
^- move
[[p.ovo]~ %give %& %noun q.ovo]
[%345 nub(run [plan]~)]
:: $prim: old $pram
:: +drum: upgrade $prim to $pram, incompatible
::
@ -1074,7 +1082,7 @@
=/ fyn (turn nyf |=([a=@tas b=vise] [a (slim b)]))
=/ rum (drum rim)
(load who now yen rum (slim dub) fyn)
:: +load: load compatible
:: +load: load compatible, notifying vanes
::
++ load
|= [who=ship now=@da yen=@ ram=pram dub=vase nyf=pane]
@ -1087,7 +1095,8 @@
==
=. ram (dram ram)
?> ?=([%345 *] ram)
(leap now (lead now `nub.ram))
=/ run plot:(spam:(lead now ~) [//arvo %vega ~])
(leap now (then:(lead now `nub.ram) run))
:: +peek: external inspect
::
++ peek
@ -1257,7 +1266,7 @@
::
=/ raw
~> %slog.[0 leaf+"vega: compiling hoon"]
(ride %noun u.hun)
(mure |.((ride %noun u.hun)))
:: activate the new compiler gate, producing +ride
::
=/ cop .*(0 +.raw)
@ -1268,12 +1277,14 @@
?> |(=(nex hoon-version) =(+(nex) hoon-version))
:: if we're upgrading language versions, recompile the compiler
::
=> ?: =(nex hoon-version)
[hot=`*`raw .]
=^ hot=* cop
?: =(nex hoon-version)
[raw cop]
~> %slog.[0 leaf+"vega: recompiling hoon {<nex>}k"]
~& [%hoon-compile-upgrade nex]
%- mure |.
=/ hot (slum cop [%noun hun])
.(cop .*(0 +.hot))
[hot .*(0 +.hot)]
:: extract the hoon core from the outer gate (+ride)
::
=/ hoc .*(cop [%0 7])
@ -1286,6 +1297,7 @@
::
=/ rav
~> %slog.[0 leaf+"vega: compiling kernel {(scow %p (mug hyp))}"]
%- mure |.
(slum cop [hyp van])
:: activate arvo, and extract the arvo core from the outer gate
::

9
pkg/arvo/sys/hoon.hoon
View File

@ -12035,6 +12035,15 @@
?~ a !!
~_(i.a $(a t.a))
::
++ mure
|* =(trap *)
^+ $:trap
=/ res (mule trap)
?- -.res
%& p.res
%| (mean leaf+"mure: road" p.res)
==
::
++ slew :: get axis in vase
|= {axe/@ vax/vase} ^- (unit vase)
?. |- ^- ?

68
pkg/arvo/sys/vane/ames.hoon
View File

@ -376,6 +376,16 @@
veb=_veb-all-off
==
::
+$ queued-event-1
$% [%call =duct type=* wrapped-task=(hobo task-1)]
[%take =wire =duct type=* =sign]
==
::
+$ task-1
$% [%wegh ~]
task
==
::
+$ ames-state-1
$: peers=(map ship ship-state-1)
=unix=duct
@ -520,45 +530,81 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames
::
++ scry scry:adult-core
++ stay [%3 %larva queued-events ames-state.adult-gate]
++ stay [%4 %larva queued-events ames-state.adult-gate]
++ load
|^
|= $= old
$% $: %3
$% [%larva events=_queued-events state=_ames-state.adult-gate]
$% $: %4
$% $: %larva
events=(qeu queued-event)
state=_ames-state.adult-gate
==
[%adult state=_ames-state.adult-gate]
== ==
::
$: %3
$% $: %larva
events=(qeu queued-event-1)
state=_ames-state.adult-gate
==
[%adult state=_ames-state.adult-gate]
== ==
::
$: %2
$% [%larva events=_queued-events state=ames-state-2]
$% [%larva events=(qeu queued-event-1) state=ames-state-2]
[%adult state=ames-state-2]
== ==
::
$% [%larva events=_queued-events state=ames-state-1]
$% [%larva events=(qeu queued-event-1) state=ames-state-1]
[%adult state=ames-state-1]
== ==
?- old
[%4 %adult *] (load:adult-core %4 state.old)
[%3 %adult *] (load:adult-core %3 state.old)
[%2 %adult *] (load:adult-core %2 state.old)
[%adult *] (load:adult-core %1 state.old)
::
[%3 %larva *]
[%4 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %4 state.old)
larval-gate
::
[%3 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events (queued-events-1-to-4 events.old)
=. adult-gate (load:adult-core %3 state.old)
larval-gate
::
[%2 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. queued-events (queued-events-1-to-4 events.old)
=. adult-gate (load:adult-core %2 state.old)
larval-gate
::
[%larva *]
~> %slog.0^leaf/"ames: larva: load"
=. queued-events events.old
=. queued-events (queued-events-1-to-4 events.old)
=. adult-gate (load:adult-core %1 state.old)
larval-gate
==
::
++ queued-events-1-to-4
|= events=(qeu queued-event-1)
^- (qeu queued-event)
%- ~(gas to *(qeu queued-event))
^- (list queued-event)
%+ murn ~(tap to events)
|= e=queued-event-1
^- (unit queued-event)
?. ?=(%call -.e)
`e
?: ?=([%wegh ~] wrapped-task.e)
~
?: ?=([%soft %wegh ~] wrapped-task.e)
~
`e
--
--
:: adult ames, after metamorphosis from larva
::
@ -633,7 +679,7 @@
[moves ames-gate]
:: +stay: extract state before reload
::
++ stay [%3 %adult ames-state]
++ stay [%4 %adult ames-state]
:: +load: load in old state after reload
::
++ load
@ -641,13 +687,15 @@
$% [%1 ames-state-1]
[%2 ames-state-2]
[%3 ^ames-state]
[%4 ^ames-state]
==
|^ ^+ ames-gate
::
=? old-state ?=(%1 -.old-state) %2^(state-1-to-2 +.old-state)
=? old-state ?=(%2 -.old-state) %3^(state-2-to-3 +.old-state)
=? old-state ?=(%3 -.old-state) %4^+.old-state
::
?> ?=(%3 -.old-state)
?> ?=(%4 -.old-state)
ames-gate(ames-state +.old-state)
::
++ state-1-to-2

293
pkg/arvo/sys/vane/clay.hoon
View File

@ -161,6 +161,7 @@
hez=(unit duct) :: sync duct
cez=(map @ta crew) :: permission groups
pud=(unit [=desk =yoki]) :: pending update
pun=(list move) :: upgrade moves
== ::
::
:: Object store.
@ -378,7 +379,6 @@
`[(weld pax pat) %mime !>(u.mim)]
::
[deletes changes]
::
-- =>
~% %clay + ~
|%
@ -756,7 +756,7 @@
=^ sut=vase nub (run-tauts sut %lib lib.pile)
=^ sut=vase nub (run-raw sut raw.pile)
=^ sut=vase nub (run-bar sut bar.pile)
=/ res=vase (slap sut hoon.pile)
=/ res=vase (mure |.((slap sut hoon.pile)))
[res nub]
::
++ parse-pile
@ -1360,7 +1360,13 @@
|(!=(~ sys-changes) !=(~ (need-vane-update changes)))
==
(sys-update yoki new-data changes)
=. ..park (emil (print deletes ~(key by changes)))
=. ..park
%- emil
=/ changed=(set path) ~(key by changes)
=/ existed=(set path) ~(key by old-lobes)
%^ print deletes
(~(int in changed) existed)
(~(dif in changed) existed)
:: clear caches if zuse reloaded
::
=/ is-zuse-new=? !=(~ sys-changes)
@ -1544,6 +1550,7 @@
zuse.u.fer
::
++ build-hoon
%- mure |.
~> %slog.0^leaf+"clay: building hoon on {<syd>}"
=/ gen
~> %mean.%hoon-parse-fail
@ -1553,6 +1560,7 @@
::
++ build-arvo
|= hoon=vase
%- mure |.
~> %slog.0^leaf+"clay: building arvo on {<syd>}"
=/ gen
~> %mean.%arvo-parse-fail
@ -1562,6 +1570,7 @@
::
++ build-zuse
|= arvo=vase
%- mure |.
~> %slog.0^leaf+"clay: building zuse on {<syd>}"
=/ gen
~> %mean.%zuse-parse-fail
@ -1572,7 +1581,7 @@
++ same-as-home
|= =path
^- ?
=/ our=lobe
=/ our-lobe=lobe
=/ datum (~(got by data) path)
?- -.datum
%& (page-to-lobe %hoon (page-to-cord p.datum))
@ -1580,7 +1589,7 @@
==
=/ =dome dom:(~(got by dos.rom) %home)
=/ =yaki (~(got by hut.ran) (~(got by hit.dome) let.dome))
=(`our (~(get by q.yaki) path))
=(`our-lobe (~(get by q.yaki) path))
--
::
++ page-to-cord
@ -1601,11 +1610,11 @@
=/ datum (~(got by data) path)
?- -.datum
%& (page-to-cord p.datum)
%| (lobe-to-cord data p.datum)
%| (lobe-to-cord p.datum)
==
::
++ lobe-to-cord
|= [data=(map path (each page lobe)) =lobe]
|= =lobe
^- @t
=- ?:(?=(%& -<) p.- (of-wain:format p.-))
|- ^- (each @t wain)
@ -1617,7 +1626,7 @@
%+ lurk:differ
=- ?:(?=(%| -<) p.- (to-wain:format p.-))
$(lobe q.q.blob)
;;((urge:clay cord) r.blob)
;;((urge cord) q.r.blob)
==
::
:: Updated q.yaki
@ -1699,20 +1708,24 @@
:: Print notification to console
::
++ print
|= [deletes=(set path) changes=(set path)]
|= [deletes=(set path) changes=(set path) additions=(set path)]
^- (list move)
|^
?~ hun
~
?: =(0 let.dom)
~
%+ weld
%+ turn ~(tap in deletes)
|^
;: weld
(paths-to-notes '-' deletes)
(paths-to-notes ':' changes)
(paths-to-notes '+' additions)
==
::
++ paths-to-notes
|= [prefix=@tD paths=(set path)]
%+ turn ~(tap in paths)
|= =path
[u.hun %give %note '-' (path-to-tank path)]
%+ turn ~(tap in changes)
|= =path
[u.hun %give %note '+' (path-to-tank path)]
[u.hun %give %note prefix (path-to-tank path)]
::
++ path-to-tank
|= =path
@ -3695,7 +3708,7 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: ver=%2 :: vane version
$: ver=%3 :: vane version
ruf=raft :: revision tree
== ::
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
@ -3878,7 +3891,26 @@
::
%trim [~ ..^$]
::
%vega [~ ..^$]
%vega
:: wake all desks, then send pending notifications
::
=^ wake-moves ..^$
=/ desks=(list [=ship =desk])
%+ welp
(turn ~(tap by dos.rom.ruf) |=([=desk *] [our desk]))
%- zing
%+ turn ~(tap by hoy.ruf)
|= [=ship =rung]
%+ turn ~(tap by rus.rung)
|= [=desk *]
[ship desk]
|- ^+ [*(list move) ..^^$]
?~ desks
[~ ..^^$]
=^ moves-1 ..^^$ $(desks t.desks)
=^ moves-2 ruf abet:wake:((de our now ski hen ruf) [ship desk]:i.desks)
[(weld moves-1 moves-2) ..^^$]
[(welp wake-moves pun.ruf) ..^$(pun.ruf ~)]
::
?(%warp %werp)
:: capture whether this read is on behalf of another ship
@ -3917,8 +3949,229 @@
::
++ load
!:
|= [%2 =raft]
..^$(ruf raft)
|^
|= old=any-state
~! [old=old new=*state-3]
=? old ?=(%2 -.old) (load-2-to-3 old)
?> ?=(%3 -.old)
..^^$(ruf +.old)
::
++ load-2-to-3
|= =state-2
^- state-3
|^
=- state-2(- %3, rom rom.-, hoy hoy.-, |7 [pud=~ pun.-])
:+ ^- pun=(list move)
%+ welp
?~ act.state-2
~
?. =(%merge -.eval-data.u.act.state-2)
~
=/ err
:- %ford-fusion
[leaf+"active merge canceled due to upgrade to ford fusion" ~]
[hen.u.act.state-2 %slip %b %drip !>([%mere %| err])]~
^- (list move)
%+ murn ~(tap to cue.state-2)
:: use ^ so we don't have to track definition of +task
::
|= [=duct task=^]
^- (unit move)
?. =(%merg -.task)
~& "queued clay write canceled due to upgrade to ford fusion:"
~& [duct [- +<]:task]
~
=/ err
:- %ford-fusion
[leaf+"queued merge canceled due to upgrade to ford fusion" ~]
`[duct %slip %b %drip !>([%mere %| err])]
^- rom=room
:- hun.rom.state-2
%- ~(urn by dos.rom.state-2)
|= [=desk =dojo-2]
^- dojo
=- dojo-2(dom -)
^- dome
=/ fer=(unit reef-cache)
?~ let.dom.dojo-2
~
=/ =yaki
(~(got by hut.ran.state-2) (~(got by hit.dom.dojo-2) let.dom.dojo-2))
`(build-reef desk q.yaki)
[ank let hit lab mim fod=*ford-cache fer=fer]:[dom.dojo-2 .]
^- hoy=(map ship rung)
%- ~(run by hoy.state-2)
|= =rung-2
^- rung
%- ~(run by rus.rung-2)
|= =rede-2
^- rede
=- rede-2(ref ref.-, dom dom.-)
:- ^- dom=dome
[ank let hit lab mim fod=*ford-cache fer=~]:[dom.rede-2 .]
^- ref=(unit rind)
?~ ref.rede-2
~
:: TODO: somehow call +wake later to notify subscribers
:- ~
^- rind
=/ rin=rind [nix bom fod haw]:u.ref.rede-2
=. rin
=/ pur=(list [inx=@ud =rand *]) ~(tap by pur.u.ref.rede-2)
|- ^+ rin
?~ pur rin
=/ =mood [p.p q.p q]:rand.i.pur
=: haw.rin (~(put by haw.rin) mood ~)
bom.rin (~(del by bom.rin) inx.i.pur)
fod.rin ?~ got=(~(get by bom.rin) inx.i.pur)
fod.rin
(~(del by fod.rin) p.u.got)
==
$(pur t.pur)
=/ pud ~(tap to waiting.pud.u.ref.rede-2)
|- ^+ rin
?~ pud rin
=: bom.rin (~(del by bom.rin) inx.i.pud)
fod.rin ?~ got=(~(get by bom.rin) inx.i.pud)
fod.rin
(~(del by fod.rin) p.u.got)
==
$(pud t.pud)
::
++ build-reef
|= [=desk data=(map path lobe)]
^- reef-cache
~> %slog.0^leaf+"clay: building reef on {<desk>}"
?: !=(%homer desk)
[!>(..ride) !>(..is) !>(..zuse)]
|^
=/ [home=? hoon=vase]
?: (same-as-home /sys/hoon/hoon)
&+!>(..ride)
|+build-hoon
:- hoon
=/ [home=? arvo=vase]
?: &(home (same-as-home /sys/arvo/hoon))
&+!>(..is)
|+(build-arvo hoon)
:- arvo
?: &(home (same-as-home /sys/zuse/hoon))
!>(..zuse)
(build-zuse arvo)
::
++ build-hoon
%- mure |.
~> %slog.0^leaf+"clay: building hoon on {<desk>}"
=/ gen
~> %mean.%hoon-parse-fail
%+ rain /sys/hoon/hoon
(lobe-to-cord (~(got by data) /sys/hoon/hoon))
~> %mean.%hoon-compile-fail
(slot 7 (slap !>(0) gen))
::
++ build-arvo
|= hoon=vase
%- mure |.
~> %slog.0^leaf+"clay: building arvo on {<desk>}"
=/ gen
~> %mean.%arvo-parse-fail
%+ rain /sys/arvo/hoon
(lobe-to-cord (~(got by data) /sys/arvo/hoon))
~> %mean.%arvo-compile-fail
(slap (slap hoon gen) (ream '..is'))
::
++ build-zuse
|= arvo=vase
%- mure |.
~> %slog.0^leaf+"clay: building zuse on {<desk>}"
=/ gen
~> %mean.%zuse-parse-fail
%+ rain /sys/zuse/hoon
(lobe-to-cord (~(got by data) /sys/zuse/hoon))
~> %mean.%zuse-compile-fail
(slap arvo gen)
::
++ same-as-home
|= =path
^- ?
=/ our-lobe=lobe (~(got by data) path)
=/ =dome-2 dom:(~(got by dos.rom.state-2) %home)
=/ =yaki (~(got by hut.ran.state-2) (~(got by hit.dome-2) let.dome-2))
=(`our-lobe (~(get by q.yaki) path))
::
++ lobe-to-cord
|= =lobe
^- @t
=- ?:(?=(%& -<) p.- (of-wain:format p.-))
|- ^- (each @t wain)
=/ =blob (~(got by lat.ran.state-2) lobe)
?- -.blob
%direct [%& ;;(@t q.q.blob)]
%delta
:- %|
%+ lurk:differ
=- ?:(?=(%| -<) p.- (to-wain:format p.-))
$(lobe q.q.blob)
~| diff=r.blob
;;((urge cord) q.r.blob)
==
--
--
::
+$ any-state $%(state-3 state-2)
+$ state-3 [%3 raft]
+$ state-2
$: %2
rom=room-2 :: domestic
hoy=(map ship rung-2) :: foreign
ran=rang :: hashes
mon=(map term beam) :: mount points
hez=(unit duct) :: sync duct
cez=(map @ta crew) :: permission groups
cue=(qeu [=duct task=^]) :: queued requests
act=active-write-2 :: active write
== ::
+$ room-2
$: hun/duct :: terminal duct
dos/(map desk dojo-2) :: native desk
== ::
+$ dojo-2
$: qyx/cult :: subscribers
dom/dome-2 :: desk state
per/regs :: read perms per path
pew/regs :: write perms per path
==
+$ dome-2
$: ank/ankh :: state
let/aeon :: top id
hit/(map aeon tako) :: versions by id
lab/(map @tas aeon) :: labels
mim/(map path mime) :: mime cache
== ::
+$ rung-2 rus=(map desk rede-2)
+$ rede-2
$: lim/@da :: complete to
ref/(unit rind-2) :: outgoing requests
qyx/cult :: subscribers
dom/dome-2 :: revision state
per/regs :: read perms per path
pew/regs :: write perms per path
== ::
+$ rind-2
$: nix/@ud :: request index
bom/(map @ud {p/duct q/rave}) :: outstanding
fod/(map duct @ud) :: current requests
haw/(map mood (unit cage)) :: simple cache
pud/update-qeu-2 :: active updates
pur/request-map-2 :: active requests
== ::
+$ request-map-2 (map inx=@ud [=rand eval-form=*])
+$ update-qeu-2
$: waiting=(qeu [inx=@ud rut=(unit rand)])
eval-data=(unit [inx=@ud rut=(unit rand) eval-form=*])
==
+$ active-write-2 (unit [hen=duct req=* eval-data=^])
--
::
++ scry :: inspect
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}

301
pkg/arvo/sys/vane/eyre.hoon
View File

@ -69,7 +69,7 @@
++ axle
$: :: date: date at which http-server's state was updated to this data structure
::
date=%~2019.10.6
date=%~2020.5.29
:: server-state: state of inbound requests
::
=server-state
@ -131,6 +131,9 @@
:: channel-timeout: the delay before a channel should be reaped
::
++ channel-timeout ~h12
:: session-timeout: the delay before an idle session expires
::
++ session-timeout ~d7
--
:: utilities
::
@ -779,6 +782,10 @@
++ request
|= [secure=? =address =request:http]
^- [(list move) server-state]
:: for requests from localhost, respect the "forwarded" header
::
=? address =([%ipv4 .127.0.0.1] address)
(fall (forwarded-for header-list.request) address)
::
=/ host (get-header:http 'host' header-list.request)
=/ action (get-action-for-binding host url.request)
@ -843,6 +850,9 @@
::
%authentication
(handle-request:authentication secure address request)
::
%logout
(handle-logout:authentication authenticated request)
::
%channel
(handle-request:by-channel secure authenticated address request)
@ -889,8 +899,12 @@
%leave ~
==
::
%authentication [~ state]
%channel on-cancel-request:by-channel
?(%authentication %logout)
[~ state]
::
%channel
on-cancel-request:by-channel
::
%four-oh-four
:: it should be impossible for a 404 page to be asynchronous
::
@ -920,7 +934,7 @@
::
++ authentication
|%
:: +handle-request: handles an http request for the
:: +handle-request: handles an http request for the login page
::
++ handle-request
|= [secure=? =address =request:http]
@ -964,14 +978,20 @@
$(eny (shas %try-again candidate))
:: record cookie and record expiry time
::
=/ expires-in=@dr ~d7
=/ first-session=? =(~ sessions.authentication-state.state)
=/ expires-at=@da (add now session-timeout)
=. sessions.authentication-state.state
(~(put by sessions.authentication-state.state) session (add now expires-in))
(~(put by sessions.authentication-state.state) session expires-at)
::
=/ max-age=tape (format-ud-as-integer `@ud`(div (msec:milly expires-in) 1.000))
=/ cookie-line
%- crip
"urbauth-{<our>}={<session>}; Path=/; Max-Age={max-age}"
=/ cookie-line=@t
(session-cookie-string session &)
::
=; out=[moves=(list move) server-state]
:: if we didn't have any cookies previously, start the expiry timer
::
?. first-session out
=- out(moves [- moves.out])
[duct %pass /sessions/expire %b %wait expires-at]
::
?~ redirect=(get-header:http 'redirect' u.parsed)
%- handle-response
@ -987,7 +1007,7 @@
=/ actual-redirect ?:(=(u.redirect '') '/' u.redirect)
%- handle-response
:* %start
:- status-code=307
:- status-code=303
^= headers
:~ ['location' actual-redirect]
['set-cookie' cookie-line]
@ -995,6 +1015,61 @@
data=~
complete=%.y
==
:: +handle-logout: handles an http request for logging out
::
++ handle-logout
|= [authenticated=? =request:http]
^- [(list move) server-state]
:: whatever we end up doing, we always redirect to the login page
::
=/ response=$>(%start http-event:http)
:* %start
response-header=[303 ['location' '/~/login']~]
data=~
complete=%.y
==
::
=/ session-id=(unit @uv)
(session-id-from-request request)
=? headers.response-header.response ?=(^ session-id)
:_ headers.response-header.response
['set-cookie' (session-cookie-string u.session-id |)]
?. &(authenticated ?=(^ session-id))
(handle-response response)
:: delete the requesting session, or all sessions if so specified
::
=. sessions.authentication-state.state
=; all=?
?: all ~
(~(del by sessions.authentication-state.state) u.session-id)
?~ body.request |
=- ?=(^ -)
%+ get-header:http 'all'
(fall (rush q.u.body.request yquy:de-purl:html) ~)
(handle-response response)
:: +session-id-from-request: attempt to find a session cookie
::
++ session-id-from-request
|= =request:http
^- (unit @uv)
:: are there cookies passed with this request?
::
:: TODO: In HTTP2, the client is allowed to put multiple 'Cookie'
:: headers.
::
?~ cookie-header=(get-header:http 'cookie' header-list.request)
~
:: is the cookie line is valid?
::
?~ cookies=(rush u.cookie-header cock:de-purl:html)
~
:: is there an urbauth cookie?
::
?~ urbauth=(get-header:http (crip "urbauth-{<our>}") u.cookies)
~
:: if it's formatted like a valid session cookie, produce it
::
`(unit @)`(rush u.urbauth ;~(pfix (jest '0v') viz:ag))
:: +request-is-logged-in: checks to see if the request is authenticated
::
:: We are considered logged in if this request has an urbauth
@ -1003,24 +1078,9 @@
++ request-is-logged-in
|= =request:http
^- ?
:: are there cookies passed with this request?
:: does the request pass a session cookie?
::
:: TODO: In HTTP2, the client is allowed to put multiple 'Cookie'
:: headers.
::
?~ cookie-header=(get-header:http 'cookie' header-list.request)
%.n
:: is the cookie line is valid?
::
?~ cookies=(rush u.cookie-header cock:de-purl:html)
%.n
:: is there an urbauth cookie?
::
?~ urbauth=(get-header:http (crip "urbauth-{<our>}") u.cookies)
%.n
:: is this formatted like a valid session cookie?
::
?~ session-id=(rush u.urbauth ;~(pfix (jest '0v') viz:ag))
?~ session-id=(session-id-from-request request)
%.n
:: is this a session that we know about?
::
@ -1038,6 +1098,17 @@
=+ res=((sloy scry) [151 %noun] %j pax)
::
(rsh 3 1 (scot %p (@ (need (need res)))))
:: +session-cookie-string: compose session cookie
::
++ session-cookie-string
|= [session=@uv extend=?]
^- @t
%- crip
=; max-age=tape
"urbauth-{<our>}={<session>}; Path=/; Max-Age={max-age}"
%- format-ud-as-integer
?. extend 0
(div (msec:milly session-timeout) 1.000)
--
:: +channel: per-event handling of requests to the channel system
::
@ -1693,12 +1764,38 @@
?^ response-header.u.connection-state
~& [%http-multiple-start duct]
error-connection
:: if request was authenticated, extend the session & cookie's life
::
=^ response-header sessions.authentication-state.state
=, authentication
=* sessions sessions.authentication-state.state
=* inbound inbound-request.u.connection-state
=* no-op [response-header.http-event sessions]
::
?. authenticated.inbound
no-op
?~ session-id=(session-id-from-request request.inbound)
:: cookies are the only auth method, so this is unexpected
::
~& [%e %authenticated-without-cookie]
no-op
?. (~(has by sessions) u.session-id)
:: if the session has expired since the request was opened,
:: tough luck, we don't create/revive sessions here
::
no-op
:_ (~(put by sessions) u.session-id (add now session-timeout))
=- response-header.http-event(headers -)
%^ set-header:http 'set-cookie'
(session-cookie-string u.session-id &)
headers.response-header.http-event
::
=. response-header.http-event response-header
=. connections.state
%+ ~(jab by connections.state) duct
|= connection=outstanding-connection
%_ connection
response-header `response-header.http-event
response-header `response-header
bytes-sent ?~(data.http-event 0 p.u.data.http-event)
==
::
@ -1768,31 +1865,11 @@
::
++ add-binding
|= [=binding =action]
::
=/ to-search bindings.state
|-
^- [(list move) server-state]
?~ to-search
:- [duct %give %bound %.y binding]~
=. bindings.state
:: store in reverse alphabetical order so that longer paths are first
::
%- flop
%+ 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)
=^ success bindings.state
(insert-binding [binding duct action] bindings.state)
:_ state
[duct %give %bound success binding]~
:: +remove-binding: removes a binding if it exists and is owned by this duct
::
++ remove-binding
@ -1868,11 +1945,56 @@
$(bindings t.bindings)
--
::
++ forwarded-for
|= =header-list:http
^- (unit address)
=/ forwarded=(unit @t)
(get-header:http 'forwarded' header-list)
?~ forwarded ~
|^ =/ forwards=(unit (list (map @t @t)))
(unpack-header:http u.forwarded)
?. ?=([~ ^] forwards) ~
=* forward i.u.forwards
?~ for=(~(get by forward) 'for') ~
::NOTE per rfc7239, non-ip values are also valid. they're not useful
:: for the general case, so we ignore them here. if needed,
:: request handlers are free to inspect the headers themselves.
::
(rush u.for ip-address)
::
++ ip-address
;~ sfix
;~(pose (stag %ipv4 ip4) (stag %ipv6 (ifix [lac rac] ip6)))
;~(pose ;~(pfix col dim:ag) (easy ~))
==
--
::
++ parse-request-line
|= url=@t
^- [[ext=(unit @ta) site=(list @t)] args=(list [key=@t value=@t])]
(fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
::
++ insert-binding
|= [[=binding =duct =action] bindings=(list [=binding =duct =action])]
=/ to-search bindings
|- ^- [? _bindings]
?^ to-search
?: =(binding binding.i.to-search)
[| bindings]
::
$(to-search t.to-search)
:- &
:: store in reverse alphabetical order so that longer paths are first
::
%- flop
%+ sort [[binding duct action] bindings]
|= [[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))
--
:: end the =~
::
@ -1913,6 +2035,7 @@
::
=. bindings.server-state.ax
:~ [[~ /~/login] duct [%authentication ~]]
[[~ /~/logout] duct [%logout ~]]
[[~ /~/channel] duct [%channel ~]]
==
[~ http-server-gate]
@ -2091,6 +2214,7 @@
::
%run-app-request run-app-request
%watch-response watch-response
%sessions sessions
%channel channel
%acme acme-ack
==
@ -2198,6 +2322,34 @@
[moves http-server-gate]
==
::
++ sessions
::
?> ?=([%b %wake *] sign)
::
?^ error.sign
[[duct %slip %d %flog %crud %wake u.error.sign]~ http-server-gate]
:: remove cookies that have expired
::
=* sessions sessions.authentication-state.server-state.ax
=. sessions.authentication-state.server-state.ax
%- ~(gas by *(map @uv session))
%+ murn ~(tap in sessions)
|= [cookie=@uv session]
^- (unit [@uv session])
?: (lth expiry-time now) ~
`[cookie expiry-time]
:: if there's any cookies left, set a timer for the next expected expiry
::
^- [(list move) _http-server-gate]
:_ http-server-gate
?: =(~ sessions) ~
=; next-expiry=@da
[duct %pass /sessions/expire %b %wait next-expiry]~
%+ roll ~(tap by sessions)
|= [[@uv session] next=@da]
?: =(*@da next) expiry-time
(min next expiry-time)
::
++ acme-ack
?> ?=([%g %unto *] sign)
::
@ -2216,44 +2368,27 @@
::
++ load
=> |%
+$ channel-old
$: state=(each timer duct)
next-id=@ud
events=(qeu [id=@ud lines=wall])
subscriptions=(map wire [ship=@p app=term =path duc=duct])
==
+$ channel-state-old
$: session=(map @t channel-old)
duct-to-key=(map duct @t)
==
++ axle-old
%+ cork
axle
|= =axle
axle(date %~2019.1.7, channel-state.server-state (channel-state-old))
+$ axle-2019-10-6
[date=%~2019.10.6 =server-state]
--
|= old=$%(axle axle-old)
|= old=$%(axle axle-2019-10-6)
^+ ..^$
::
~! %loading
?- -.old
%~2019.1.7
=/ add-heartbeat
%- ~(run by session.channel-state.server-state.old)
|= [c=channel-old]
^- channel
[state.c next-id.c events.c subscriptions.c ~]
%~2020.5.29 ..^$(ax old)
::
=/ new
%= old
date %~2019.10.6
session.channel-state.server-state add-heartbeat
%~2019.10.6
=^ success bindings.server-state.old
%+ insert-binding
[[~ /~/logout] [/e/load/logout]~ [%logout ~]]
bindings.server-state.old
~? !success [%e %failed-to-setup-logout-endpoint]
%_ $
date.old %~2020.5.29
sessions.authentication-state.server-state.old ~
==
$(old new)
::
%~2019.10.6 ..^$(ax old)
==
:: +stay: produce current state
::
++ stay `axle`ax

10
pkg/arvo/sys/vane/ford.hoon Normal file
View File

@ -0,0 +1,10 @@
!:
|= pit=vase
|= [our=ship now=@da eny=@uvJ ski=sley]
|%
++ call |=(* ~&(%ford-call-gone `..^$))
++ take |=(* ~&(%ford-take-gone `..^$))
++ scry |=(* ``mass+!>(*(list mass)))
++ stay ~
++ load |=(* ..^$)
--

647
pkg/arvo/sys/vane/gall.hoon
View File

@ -1,4 +1,4 @@
!: :: %gall, agent execution
:: :: %gall, agent execution
!? 163
::
::::
@ -107,12 +107,7 @@
:: |migrate: data structures for upgrades
::
+| %migrate
:: $bolus: incoming move to a pupa, enqueued in a $chrysalis
::
+$ bolus
$% [%call =duct =task:able]
[%take =wire =duct sign=sign-arvo]
==
:: $spore: structures for update, produced by +stay
::
+$ spore
@ -243,622 +238,68 @@
+$ all-state $%(state-0 state-1 state-2 state-3 state-4 state-5 ^spore)
::
++ state-5-to-spore-6
|= =state-5
|= s=state-5
^- ^spore
%= state-5
%= s
- %6
running.agents-5
%- ~(run by running.agents-5.state-5)
|=(=yoke-3 `egg`+:yoke-3(agent on-save:agent.yoke-3))
outstanding ~ :: TODO: do we need to process these somehow?
running
(~(run by running.s) |=(y=yoke-0 +:y(agent on-save:agent.y)))
==
::
++ state-5
$: %5
agents-5=agents-3
==
++ state-4-to-5 |=(s=state-4 `state-5`s(- %5, outstanding ~))
++ state-3-to-4 |=(s=state-3 `state-4`s(- %4, outstanding ~))
++ state-2-to-3 |=(s=state-2 `state-3`s(- %3))
++ state-1-to-2 |=(s=state-1 `state-2`s(- %2, +< +<.s, +> `+>.s))
++ state-0-to-1 |=(s=state-0 `state-1`s(- %1))
::
++ state-4-to-5
|= =state-4
^- state-5
%= state-4
- %5
outstanding.agents-4 ~
==
+$ state-5 [%5 agents-2]
+$ state-4 [%4 agents-2]
+$ state-3 [%3 agents-2]
+$ state-2 [%2 agents-2]
+$ state-1 [%1 agents-0]
+$ state-0 [%0 agents-0]
::
++ state-4
$: %4
agents-4=agents-3
==
::
++ state-3-to-4
|= =state-3
^- state-4
%= state-3
- %4
outstanding.agents-3 ~
==
::
++ state-3
$: %3
=agents-3
==
::
++ agents-3
+$ agents-2
$: system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
running=(map term yoke-3)
running=(map term yoke-0)
blocked=(map term (qeu blocked-move))
==
::
++ yoke-3
$: cache=worm
control-duct=duct
live=?
=stats
=watches
=agent
=beak
marks=(map duct mark)
==
::
++ state-2-to-3
|= =state-2
^- state-3
%= state-2
- %3
running.agents-2
%- ~(run by running.agents-2.state-2)
|= =yoke-2
^- yoke-3
%= yoke-2
agent-2 (agent-2-to-3 agent-2.yoke-2)
==
==
::
++ agent-2-to-3
|= =agent-2
^- agent
=> |%
++ cards-2-to-3
|= cards=(list card:^agent-2)
^- (list card:agent)
%+ turn cards
|= =card:^agent-2
^- card:agent
?. ?=([%give ?(%fact %kick) *] card) card
%=(card path.p (drop path.p.card))
--
|_ =bowl:gall
+* this .
pass ~(. agent-2 bowl)
++ on-init
=^ cards agent-2 on-init:pass
[(cards-2-to-3 cards) this]
::
++ on-save
on-save:pass
::
++ on-load
|= old-state=vase
=^ cards agent-2 (on-load:pass old-state)
[(cards-2-to-3 cards) this]
::
++ on-poke
|= [=mark =vase]
=^ cards agent-2 (on-poke:pass mark vase)
[(cards-2-to-3 cards) this]
::
++ on-watch
|= =path
=^ cards agent-2 (on-watch:pass path)
[(cards-2-to-3 cards) this]
::
++ on-leave
|= =path
=^ cards agent-2 (on-leave:pass path)
[(cards-2-to-3 cards) this]
::
++ on-peek
|= =path
(on-peek:pass path)
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards agent-2 (on-agent:pass wire sign)
[(cards-2-to-3 cards) this]
::
++ on-arvo
|= [=wire =sign-arvo]
=^ cards agent-2 (on-arvo:pass wire sign-arvo)
[(cards-2-to-3 cards) this]
::
++ on-fail
|= [=term =tang]
=^ cards agent-2 (on-fail:pass term tang)
[(cards-2-to-3 cards) this]
--
::
++ state-2
$: %2
=agents-2
==
::
++ agents-2
$: system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
running=(map term yoke-2)
blocked=(map term (qeu blocked-move))
==
::
++ yoke-2
$: cache=worm
control-duct=duct
live=?
=stats
=watches
=agent-2
=beak
marks=(map duct mark)
==
::
++ agent-2
=< form
|%
+$ step (quip card form)
+$ card (wind note gift)
+$ note note:agent
+$ task task:agent
+$ sign sign:agent
+$ gift
$% [%fact path=(unit path) =cage]
[%kick path=(unit path) ship=(unit ship)]
[%watch-ack p=(unit tang)]
[%poke-ack p=(unit tang)]
==
++ form
$_ ^|
|_ bowl
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ old-state=vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
--
::
++ state-1-to-2
|= =state-1
^- state-2
%= state-1
- %2
+.agents-1 [~ +.agents-1.state-1]
==
::
++ state-1
$: %1
=agents-1
==
::
++ agents-1
$: system-duct=duct
contacts=(set ship)
running=(map term yoke-2)
blocked=(map term (qeu blocked-move))
==
::
++ state-0-to-1
|= =state-0
^- state-1
%= state-0
- %1
running.agents-0
%- ~(run by running.agents-0.state-0)
|= =yoke-0
^- yoke-2
%= yoke-0
agent-0 (agent-0-to-1 agent-0.yoke-0)
==
==
::
++ agent-0-to-1
|= =agent-0
^- agent-2
|_ =bowl:gall
+* this .
pass ~(. agent-0 bowl)
++ on-init
=^ cards agent-0 on-init:pass
[cards this]
::
++ on-save
on-save:pass
::
++ on-load
|= old-state=vase
=^ cards agent-0 (on-load:pass old-state)
[cards this]
::
++ on-poke
|= [=mark =vase]
=^ cards agent-0 (on-poke:pass mark vase)
[cards this]
::
++ on-watch
|= =path
=^ cards agent-0 (on-watch:pass path)
[cards this]
::
++ on-leave
|= =path
=^ cards agent-0 (on-leave:pass path)
[cards this]
::
++ on-peek
|= =path
(on-peek:pass path)
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards agent-0 (on-agent:pass wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
?< ?=([%d %pack *] sign-arvo)
=^ cards agent-0 (on-arvo:pass wire `sign-arvo-0`sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
=^ cards agent-0 (on-fail:pass term tang)
[cards this]
--
::
++ state-0
$: %0
=agents-0
==
::
++ agents-0
+$ agents-0
$: system-duct=duct
contacts=(set ship)
running=(map term yoke-0)
blocked=(map term (qeu blocked-move))
==
::
++ yoke-0
+$ yoke-0
$: cache=worm
control-duct=duct
live=?
=stats
=watches
=agent-0
agent=any-agent
=beak
marks=(map duct mark)
==
::
++ agent-0
=< form
|%
+$ step (quip card form)
+$ card (wind note gift)
+$ note note:agent
+$ task task:agent
+$ gift gift:agent-2
+$ sign sign:agent
++ form
$_ ^|
++ any-agent
$_
^|
|_ bowl
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ old-state=vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo-0]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
--
::
++ sign-arvo-0
$% {$a gift:able:ames}
$: $b
$% gift:able:behn
$>(%wris gift:able:clay)
$>(%writ gift:able:clay)
$>(%mere gift:able:clay)
$>(%unto gift:able:gall)
==
==
{$c gift:able:clay}
{$d $<(%pack gift:able:dill)}
{$f gift:ford}
[%e gift:able:eyre]
{$g gift:able:gall}
[%i gift:able:iris]
{$j gift:able:jael}
==
::
++ ford
|%
+= gift
$% :: %made: build result; response to %build +task
::
$: %made
:: date: formal date of the build
::
date=@da
:: result: result of the build; either complete build, or error
::
result=made-result
== ==
+= made-result
$% :: %complete: contains the result of the completed build
::
[%complete =build-result]
:: %incomplete: couldn't finish build; contains error message
::
[%incomplete =tang]
==
+= build-result
$% :: %error: the build produced an error whose description is :message
::
[%error message=tang]
:: %success: result of successful +build, tagged by +schematic sub-type
::
$: %success
$^ [head=build-result tail=build-result]
$% [%$ =cage]
[%alts =build-result]
[%bake =cage]
[%bunt =cage]
[%call =vase]
[%cast =cage]
[%core =vase]
[%diff =cage]
[%hood =scaffold]
[%join =cage]
[%list results=(list build-result)]
[%mash =cage]
[%mute =cage]
[%pact =cage]
[%path =rail]
[%plan =vase]
[%reef =vase]
[%ride =vase]
[%scry =cage]
[%slim [=type =nock]]
[%slit =type]
[%vale =cage]
[%volt =cage]
[%walk results=(list mark-action)]
== == ==
+= scaffold
$: :: source-rail: the file this scaffold was parsed from
::
source-rail=rail
:: zuse-version: the kelvin version of the standard library
::
zuse-version=@ud
:: structures: files from %/sur which are included
::
structures=(list cable)
:: libraries: files from %/lib which are included
::
libraries=(list cable)
:: cranes: a list of resources to transform and include
::
cranes=(list crane)
:: sources: hoon sources, either parsed or on the filesystem
::
sources=(list hoon)
==
+= mark-action [type=?(%grow %grab) source=term target=term]
+= rail [=disc =spur]
+$ cable
$: face=(unit term)
file-path=term
==
+= crane
$% $: :: %fssg: `/~` hoon literal
::
:: `/~ <hoon>` produces a crane that evaluates arbitrary hoon.
::
%fssg
=hoon
==
$: :: %fsbc: `/$` process query string
::
:: `/$` will call a gate with the query string supplied to this
:: build. If no query string, this errors.
::
%fsbc
=hoon
==
$: :: %fsbr: `/|` first of many options that succeeds
::
:: `/|` takes a series of cranes and produces the first one
:: (left-to-right) that succeeds. If none succeed, it produces
:: stack traces from all of its arguments.
::
%fsbr
:: choices: cranes to try
::
choices=(list crane)
==
$: :: %fsts: `/=` wrap a face around a crane
::
:: /= runs a crane (usually produced by another ford rune), takes
:: the result of that crane, and wraps a face around it.
::
%fsts
:: face: face to apply
::
face=term
:: crane: internal build step
::
=crane
==
$: :: %fsdt: `/.` null-terminated list
::
:: Produce a null-terminated list from a sequence of cranes,
:: terminated by a `==`.
::
%fsdt
:: items: cranes to evaluate
::
items=(list crane)
==
$: :: %fscm: `/,` switch by path
::
:: `/,` is a switch statement, which picks a branch to evaluate
:: based on whether the current path matches the path in the
:: switch statement. Takes a sequence of pairs of (path, crane)
:: terminated by a `==`.
::
%fscm
:: cases: produces evaluated crane of first +spur match
::
cases=(list (pair spur crane))
==
$: :: %fspm: `/&` pass through a series of marks
::
:: `/&` passes a crane through multiple marks, right-to-left.
::
%fspm
:: marks: marks to apply to :crane, in reverse order
::
marks=(list mark)
=crane
==
$: :: %fscb: `/_` run a crane on each file in the current directory
::
:: `/_` takes a crane as an argument. It produces a new crane
:: representing the result of mapping the supplied crane over the
:: list of files in the current directory. The keys in the
:: resulting map are the basenames of the files in the directory,
:: and each value is the result of running that crane on the
:: contents of the file.
::
%fscb
=crane
==
$: :: %fssm: `/;` operate on
::
:: `/;` takes a hoon and a crane. The hoon should evaluate to a
:: gate, which is then called with the result of the crane as its
:: sample.
::
%fssm
=hoon
=crane
==
$: :: %fscl: `/:` evaluate at path
::
:: `/:` takes a path and a +crane, and evaluates the crane with
:: the current path set to the supplied path.
::
%fscl
:: path: late bound path to be resolved relative to current beak
::
:: This becomes current path of :crane
::
path=truss
=crane
==
$: :: %fskt: `/^` cast
::
:: `/^` takes a +mold and a +crane, and casts the result of the
:: crane to the mold.
::
%fskt
:: mold: evaluates to a mold to be applied to :crane
::
=spec
=crane
==
$: :: %fstr: `/*` run :crane on all files with current path as prefix
::
%fstr
=crane
==
$: :: %fszp: `/!mark/` evaluate as hoon, then pass through mark
::
%fszp
=mark
==
$: :: %fszy: `/mark/` passes current path through :mark
::
%fszy
=mark
== ==
+= truss
$: pre=(unit tyke)
pof=(unit [p=@ud q=tyke])
==
++ on-init **
++ on-save *vase
++ on-load **
++ on-poke **
++ on-watch **
++ on-leave **
++ on-peek **
++ on-agent **
++ on-arvo **
++ on-fail **
--
--
--
@ -1143,16 +584,26 @@
=/ tim (slav da+dat)
=/ =beak [(slav %p her) desk da+tim]
?> ?=([?(%b %c) %writ *] sign-arvo)
?^ p.sign-arvo
|^ ^+ mo-core
?~ p.sign-arvo
(fail leaf+"gall: failed to build agent {<dap>}" ~)
=/ cag=cage r.u.p.sign-arvo
?. =(%vase p.cag)
(mo-give %onto |+[leaf+"gall: invalid %writ {<p.cag>} for {<dap>}"]~)
(fail leaf+"gall: bad %writ {<p.cag>} for {<dap>}" ~)
=/ res (mule |.(!<(agent !<(vase q.cag))))
?: ?=(%| -.res)
(mo-give %onto |+[leaf+"gall: {<dap>}" p.res])
(fail leaf+["gall: bad agent {<dap>}"] p.res)
=. mo-core (mo-receive-core dap beak p.res)
(mo-subscribe-to-agent-builds tim)
(mo-give %onto |+[leaf+"gall: failed to build agent {<dap>}"]~)
::
++ fail
|= =tang
^+ mo-core
=. mo-core (mo-give %onto |+tang)
=/ =case [%da tim]
=/ =wire /sys/cor/[dap]/[her]/[desk]/(scot case)
(mo-pass wire %c %warp p.beak desk ~ %next %a case /app/[dap]/hoon)
--
:: +mo-handle-sys-lyv: handle notice that agents have been rebuilt
::
++ mo-handle-sys-lyv

89
pkg/arvo/sys/zuse.hoon
View File

@ -356,6 +356,45 @@
t.header-list
::
[i.header-list $(header-list t.header-list)]
:: +unpack-header: parse header field values
::
++ unpack-header
|^ |= value=@t
^- (unit (list (map @t @t)))
(rust (cass (trip value)) values)
::
++ values
%+ more
(ifix [. .]:(star ;~(pose ace (just '\09'))) com)
pairs
::
++ pairs
%+ cook
~(gas by *(map @t @t))
%+ more (ifix [. .]:(star ace) mic)
;~(plug token ;~(pose ;~(pfix tis value) (easy '')))
::
++ value
;~(pose token quoted-string)
::
++ token :: 7230 token
%+ cook crip
::NOTE this is ptok:de-purl:html, but can't access that here
%- plus
;~ pose
aln zap hax bus cen pad say tar lus
hep dot ket cab tec bar sig
==
::
++ quoted-string :: 7230 quoted string
%+ cook crip
%+ ifix [. .]:;~(less (jest '\\"') yel)
%- star
;~ pose
;~(pfix bat ;~(pose (just '\09') ace prn))
;~(pose (just '\09') ;~(less (mask "\22\5c\7f") (shim 0x20 0xff)))
==
--
:: +simple-payload: a simple, one event response used for generators
::
+$ simple-payload
@ -1368,6 +1407,9 @@
:: internal authentication page
::
[%authentication ~]
:: internal logout page
::
[%logout ~]
:: gall channel system
::
[%channel ~]
@ -1563,6 +1605,53 @@
::
(gte i.b 224)
==
:: +ipa: parse ip address
::
++ ipa
;~(pose (stag %ipv4 ip4) (stag %ipv6 ip6))
:: +ip4: parse ipv4 address
::
++ ip4
=+ byt=(ape:ag ted:ab)
(bass 256 ;~(plug byt (stun [3 3] ;~(pfix dot byt))))
:: +ip6: parse ipv6 address
::
++ ip6
%+ bass 0x1.0000
%+ sear
|= hexts=(list $@(@ [~ %zeros]))
^- (unit (list @))
:: not every list of hextets is an ipv6 address
::
=/ legit=?
=+ l=(lent hexts)
=+ c=|=(a=* ?=([~ %zeros] a))
?| &((lth l 8) ?=([* ~] (skim hexts c)))
&(=(8 l) !(lien hexts c))
==
?. legit ~
%- some
:: expand zeros
::
%- zing
%+ turn hexts
|= hext=$@(@ [~ %zeros])
?@ hext [hext]~
(reap (sub 9 (lent hexts)) 0)
:: parse hextets, producing cell for shorthand zeroes
::
|^ %+ cook
|= [a=(list @) b=(list [~ %zeros]) c=(list @)]
:(welp a b c)
;~ plug
(more col het)
(stun [0 1] cel)
(more col het)
==
++ cel (cold `%zeros ;~(plug col col))
++ het (bass 16 (stun [1 4] six:ab))
--
::
++ rout {p/(list host) q/path r/oryx s/path} :: http route (new)
++ user knot :: username
-- ::eyre

73
pkg/arvo/tests/sys/vane/eyre.hoon
View File

@ -612,12 +612,12 @@
^- (hypo sign:eyre-gate) :- *type
:* %g %unto %fact
%http-response-header
!>([307 ['location' '/~/login?redirect=/~landscape/inner-path']~])
!>([303 ['location' '/~/login?redirect=/~landscape/inner-path']~])
==
==
^= expected-move
:~ :* duct=~[/http-blah] %give %response
[%start [307 ['location' '/~/login?redirect=/~landscape/inner-path']~] ~ %.n]
[%start [303 ['location' '/~/login?redirect=/~landscape/inner-path']~] ~ %.n]
== == ==
:: the browser then fetches the login page
::
@ -642,7 +642,7 @@
[%ipv4 .192.168.1.1]
%'GET'
'/~landscape/inner-path'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
==
^= comparator
@ -682,7 +682,7 @@
[%ipv4 .192.168.1.1]
:* %'GET'
'/~landscape/inner-path'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
== ==
==
@ -980,7 +980,7 @@
[%ipv4 .192.168.1.1]
%'GET'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
==
^= expected-moves
@ -998,6 +998,7 @@
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
::
:- ~
@ -1078,7 +1079,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -1107,7 +1108,7 @@
card.i.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.t.moves
::
%+ expect-eq
@ -1178,7 +1179,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -1206,7 +1207,7 @@
card.i.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.t.moves
::
%+ expect-eq
@ -1279,7 +1280,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -1308,7 +1309,7 @@
card.i.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.t.moves
::
%+ expect-eq
@ -1369,7 +1370,7 @@
[%ipv4 .192.168.1.1]
%'GET'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
==
^= expected-moves
@ -1387,6 +1388,7 @@
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
::
:- ~
@ -1429,7 +1431,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -1455,7 +1457,7 @@
card.i.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.t.moves
== ==
:: gall responds on the second subscription.
@ -1567,7 +1569,7 @@
[%ipv4 .192.168.1.1]
%'GET'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
==
^= expected-moves
@ -1585,6 +1587,7 @@
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
::
:- ~
@ -1652,7 +1655,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -1670,7 +1673,7 @@
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.moves
==
:: the client connection is detected to be broken
@ -1727,7 +1730,7 @@
[%ipv4 .192.168.1.1]
%'GET'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
~
==
^= expected-moves
@ -1745,6 +1748,7 @@
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
::
:- ~
@ -2093,14 +2097,17 @@
==
^= expected-moves
^- (list move:eyre-gate)
:~ :* duct=~[/http-blah]
:~ ::NOTE this ~d7 is tied to the eyre-internal +session-timeout...
:- duct=~[/http-blah]
[%pass p=/sessions/expire q=[%b [%wait p=(add start-now ~d7.m1)]]]
::
:* duct=~[/http-blah]
%give
%response
%start
:- 307
:- 303
:~ ['location' '/~landscape']
:- 'set-cookie'
'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea; Path=/; Max-Age=604800'
['set-cookie' cookie-string]
==
~
complete=%.y
@ -2147,7 +2154,7 @@
[%ipv4 .192.168.1.1]
%'PUT'
'/~/channel/0123456789abcdef'
['cookie' 'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea']~
['cookie' cookie-value]~
::
:- ~
%- as-octs:mimes:html
@ -2189,7 +2196,7 @@
card.i.t.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> put-200-response
!> i.t.t.moves
::
%+ expect-eq
@ -2226,4 +2233,22 @@
?~ data headers
%+ weld headers
['content-length' (crip ((d-co:co 1) p.u.data))]~
:: produce the 200 response to a put request
::
++ put-200-response
:* ~[/http-put-request]
%give
%response
%start
[200 ['set-cookie' cookie-string]~]
~
%.y
==
::
++ cookie-value
'urbauth-~nul=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea'
::
++ cookie-string
%^ cat 3 cookie-value
'; Path=/; Max-Age=604800'
--

6
pkg/interface/dbug/src/js/views/eyre.js
View File

@ -168,6 +168,12 @@ export class Eyre extends Component {
<h4>Cookies</h4>
<button onClick={this.loadAuthenticationState}>refresh</button>
<form method="post" action="/~/logout">
<button type="submit">logout</button>
</form>
<form method="post" action="/~/logout">
<button type="submit" name="all">logout all</button>
</form>
{sessionItems}
</>);
}