mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-03 04:40:50 +03:00
mall: convert aqua vane handlers to mall
This commit is contained in:
Philip Monk
parent
30f74368fb
commit
34ab4c4e77
52
pkg/arvo/age/aqua-ames.hoon
Normal file
52
pkg/arvo/age/aqua-ames.hoon
Normal file
@ -0,0 +1,52 @@
|
||||
:: This needs a better SDN solution. Every ship should have an IP
|
||||
:: address, and we should eventually test changing those IP
|
||||
:: addresses.
|
||||
::
|
||||
:: For now, we broadcast every packet to every ship and rely on them
|
||||
:: to drop them.
|
||||
::
|
||||
/- aquarium
|
||||
/+ aqua-vane
|
||||
=, aquarium
|
||||
=| ships=(list ship)
|
||||
|%
|
||||
++ emit-aqua-events
|
||||
|= [our=ship aes=(list aqua-event)]
|
||||
^- (list card:agent:mall)
|
||||
[%pass /aqua-events %agent [our %aqua] %poke %aqua-events !>(aes)]~
|
||||
::
|
||||
++ handle-restore
|
||||
|= [our=ship who=@p]
|
||||
^- (quip card:agent:mall _ships)
|
||||
:_ ships
|
||||
%+ emit-aqua-events our
|
||||
[%event who [//newt/0v1n.2m9vh %barn ~]]~
|
||||
::
|
||||
++ handle-send
|
||||
|= [our=ship now=@da way=wire %send lan=lane:ames pac=@]
|
||||
^- (quip card:agent:mall _ships)
|
||||
=/ hear [//newt/0v1n.2m9vh %hear lan pac]
|
||||
=? ships =(~ ships)
|
||||
.^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun)
|
||||
:_ ships
|
||||
%+ emit-aqua-events our
|
||||
%+ turn ships
|
||||
|= who=ship
|
||||
[%event who hear]
|
||||
--
|
||||
::
|
||||
%- aqua-vane
|
||||
|_ =bowl:mall
|
||||
+* this .
|
||||
++ handle-unix-effect
|
||||
|= [who=@p ue=unix-effect]
|
||||
^- (quip card:agent:mall _this)
|
||||
=^ cards ships
|
||||
?+ -.q.ue `ships
|
||||
%restore (handle-restore our.bowl who)
|
||||
%send (handle-send our.bowl now.bowl ue)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ handle-arvo-response _!!
|
||||
--
|
||||
110
pkg/arvo/age/aqua-behn.hoon
Normal file
110
pkg/arvo/age/aqua-behn.hoon
Normal file
@ -0,0 +1,110 @@
|
||||
/- aquarium
|
||||
/+ aqua-vane
|
||||
=, aquarium
|
||||
|%
|
||||
+$ pier next-timer=(unit @da)
|
||||
--
|
||||
::
|
||||
=| piers=(map ship pier)
|
||||
::
|
||||
|%
|
||||
++ pe
|
||||
|= [bowl:mall who=ship]
|
||||
=+ (~(gut by piers) who *pier)
|
||||
=* pier-data -
|
||||
=| cards=(list card:agent:mall)
|
||||
|%
|
||||
++ this .
|
||||
++ abet-pe
|
||||
^- (quip card:agent:mall _piers)
|
||||
=. piers (~(put by piers) who pier-data)
|
||||
[(flop cards) piers]
|
||||
::
|
||||
++ emit-cards
|
||||
|= cs=(list card:agent:mall)
|
||||
%_(this cards (weld cs cards))
|
||||
::
|
||||
++ emit-aqua-events
|
||||
|= aes=(list aqua-event)
|
||||
%- emit-cards
|
||||
[%pass /aqua-events %agent [our %aqua] %poke %aqua-events !>(aes)]~
|
||||
::
|
||||
++ handle-sleep
|
||||
^+ ..abet-pe
|
||||
=< ..abet-pe(pier-data *pier)
|
||||
?~ next-timer
|
||||
..abet-pe
|
||||
cancel-timer
|
||||
::
|
||||
++ handle-restore
|
||||
^+ ..abet-pe
|
||||
=. this
|
||||
%- emit-aqua-events
|
||||
[%event who [//behn/0v1n.2m9vh %born ~]]~
|
||||
..abet-pe
|
||||
::
|
||||
++ handle-doze
|
||||
|= [way=wire %doze tim=(unit @da)]
|
||||
^+ ..abet-pe
|
||||
?~ tim
|
||||
?~ next-timer
|
||||
..abet-pe
|
||||
cancel-timer
|
||||
?~ next-timer
|
||||
(set-timer u.tim)
|
||||
(set-timer:cancel-timer u.tim)
|
||||
::
|
||||
++ set-timer
|
||||
|= tim=@da
|
||||
~? debug=| [who=who %setting-timer tim]
|
||||
=. next-timer `tim
|
||||
=. this (emit-cards [%pass /(scot %p who) %arvo %b %wait tim]~)
|
||||
..abet-pe
|
||||
::
|
||||
++ cancel-timer
|
||||
~? debug=| [who=who %cancell-timer (need next-timer)]
|
||||
=. this
|
||||
(emit-cards [%pass /(scot %p who) %arvo %b %rest (need next-timer)]~)
|
||||
=. next-timer ~
|
||||
..abet-pe
|
||||
::
|
||||
++ take-wake
|
||||
|= [way=wire error=(unit tang)]
|
||||
~? debug=| [who=who %aqua-behn-wake now error=error]
|
||||
=. next-timer ~
|
||||
=. this
|
||||
%- emit-aqua-events
|
||||
:_ ~
|
||||
^- aqua-event
|
||||
:+ %event who
|
||||
:- //behn/0v1n.2m9vh
|
||||
?~ error
|
||||
[%wake ~]
|
||||
[%crud %fail u.error]
|
||||
..abet-pe
|
||||
--
|
||||
--
|
||||
::
|
||||
%- aqua-vane
|
||||
|_ =bowl:mall
|
||||
+* this .
|
||||
++ handle-unix-effect
|
||||
|= [who=@p ue=unix-effect:aquarium]
|
||||
^- (quip card:agent:mall _this)
|
||||
=^ cards piers
|
||||
?+ -.q.ue `piers
|
||||
%sleep abet-pe:handle-sleep:(pe bowl who)
|
||||
%restore abet-pe:handle-restore:(pe bowl who)
|
||||
%doze abet-pe:(handle-doze:(pe bowl who) ue)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ handle-arvo-response
|
||||
|= [=wire =sign-arvo]
|
||||
?> ?=([%b %wake *] sign-arvo)
|
||||
?> ?=([@ *] wire)
|
||||
=/ who (,@p (slav %p i.wire))
|
||||
=^ cards piers
|
||||
abet-pe:(take-wake:(pe bowl who) t.wire error.sign-arvo)
|
||||
[cards this]
|
||||
--
|
||||
46
pkg/arvo/age/aqua-dill.hoon
Normal file
46
pkg/arvo/age/aqua-dill.hoon
Normal file
@ -0,0 +1,46 @@
|
||||
:: Would love to see a proper stateful terminal handler. Ideally,
|
||||
:: you'd be able to ^X into the virtual ship, like the old ^W.
|
||||
::
|
||||
:: However, that's probably not the primary way of interacting with
|
||||
:: it. In practice, most of the time you'll be running from a file
|
||||
:: (eg for automated testing) or fanning the same command to multiple
|
||||
:: ships or otherwise making use of the fact that we can
|
||||
:: programmatically send events.
|
||||
::
|
||||
/- aquarium
|
||||
/+ aqua-vane
|
||||
|%
|
||||
++ handle-blit
|
||||
|= [who=@p way=wire %blit blits=(list blit:dill)]
|
||||
^- (list card:agent:mall)
|
||||
=/ last-line
|
||||
%+ roll blits
|
||||
|= [b=blit:dill line=tape]
|
||||
?- -.b
|
||||
%lin (tape p.b)
|
||||
%mor ~& "{<who>}: {line}" ""
|
||||
%hop line
|
||||
%bel line
|
||||
%clr ""
|
||||
%sag ~& [%save-jamfile-to p.b] line
|
||||
%sav ~& [%save-file-to p.b] line
|
||||
%url ~& [%activate-url p.b] line
|
||||
==
|
||||
~? !=(~ last-line) last-line
|
||||
~
|
||||
--
|
||||
::
|
||||
%- aqua-vane
|
||||
|_ =bowl:mall
|
||||
+* this .
|
||||
++ handle-unix-effect
|
||||
|= [who=@p ue=unix-effect:aquarium]
|
||||
^- (quip card:agent:mall _this)
|
||||
=/ cards
|
||||
?+ -.q.ue ~
|
||||
%blit (handle-blit who ue)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ handle-arvo-response _!!
|
||||
--
|
||||
128
pkg/arvo/age/aqua-eyre.hoon
Normal file
128
pkg/arvo/age/aqua-eyre.hoon
Normal file
@ -0,0 +1,128 @@
|
||||
:: Pass-through Eyre driver
|
||||
::
|
||||
/- aquarium
|
||||
/+ aqua-vane
|
||||
=, aquarium
|
||||
|%
|
||||
+$ pier http-requests=(set @ud)
|
||||
--
|
||||
::
|
||||
=| piers=(map ship pier)
|
||||
::
|
||||
|%
|
||||
++ pe
|
||||
|= [bowl:mall who=ship]
|
||||
=+ (~(gut by piers) who *pier)
|
||||
=* pier-data -
|
||||
=| cards=(list card:agent:mall)
|
||||
|%
|
||||
++ this .
|
||||
++ abet-pe
|
||||
^- (quip card:agent:mall _piers)
|
||||
=. piers (~(put by piers) who pier-data)
|
||||
[(flop cards) piers]
|
||||
::
|
||||
++ emit-cards
|
||||
|= cs=(list card:agent:mall)
|
||||
%_(this cards (weld cs cards))
|
||||
::
|
||||
++ emit-aqua-events
|
||||
|= aes=(list aqua-event)
|
||||
%- emit-cards
|
||||
[%pass /aqua-events %agent [our %aqua] %poke %aqua-events !>(aes)]~
|
||||
::
|
||||
++ handle-sleep
|
||||
^+ ..abet-pe
|
||||
..abet-pe(pier-data *pier)
|
||||
::
|
||||
++ handle-restore
|
||||
^+ ..abet-pe
|
||||
=. this
|
||||
%- emit-aqua-events
|
||||
[%event who [//http/0v1n.2m9vh %born ~]]~
|
||||
..abet-pe
|
||||
::
|
||||
++ handle-thus
|
||||
|= [way=wire %thus num=@ud req=(unit hiss:eyre)]
|
||||
^+ ..abet-pe
|
||||
?~ req
|
||||
?. (~(has in http-requests) num)
|
||||
..abet-pe
|
||||
:: Eyre doesn't support cancelling HTTP requests from userspace,
|
||||
:: so we remove it from our state so we won't pass along the
|
||||
:: response.
|
||||
::
|
||||
~& [who=who %aqua-eyre-cant-cancel-thus num=num]
|
||||
=. http-requests (~(del in http-requests) num)
|
||||
..abet-pe
|
||||
~& [who=who %aqua-eyre-requesting u.req]
|
||||
=. http-requests (~(put in http-requests) num)
|
||||
=. this
|
||||
%- emit-cards :_ ~
|
||||
:* %pass
|
||||
/(scot %p who)/(scot %ud num)
|
||||
%arvo
|
||||
%i
|
||||
%request
|
||||
(hiss-to-request:html u.req)
|
||||
*outbound-config:iris
|
||||
==
|
||||
..abet-pe
|
||||
::
|
||||
:: Pass HTTP response back to virtual ship
|
||||
::
|
||||
++ take-sigh-httr
|
||||
|= [way=wire res=httr:eyre]
|
||||
^+ ..abet-pe
|
||||
?> ?=([@ ~] way)
|
||||
=/ num (slav %ud i.way)
|
||||
?. (~(has in http-requests) num)
|
||||
~& [who=who %ignoring-httr num=num]
|
||||
..abet-pe
|
||||
=. http-requests (~(del in http-requests) num)
|
||||
=. this
|
||||
(emit-aqua-events [%event who [//http/0v1n.2m9vh %receive num [%start [p.res q.res] r.res &]]]~)
|
||||
..abet-pe
|
||||
::
|
||||
:: Got error in HTTP response
|
||||
::
|
||||
++ take-sigh-tang
|
||||
|= [way=wire tan=tang]
|
||||
^+ ..abet-pe
|
||||
?> ?=([@ ~] way)
|
||||
=/ num (slav %ud i.way)
|
||||
?. (~(has in http-requests) num)
|
||||
~& [who=who %ignoring-httr num=num]
|
||||
..abet-pe
|
||||
=. http-requests (~(del in http-requests) num)
|
||||
%- (slog tan)
|
||||
..abet-pe
|
||||
--
|
||||
--
|
||||
::
|
||||
%- aqua-vane
|
||||
|_ =bowl:mall
|
||||
+* this .
|
||||
++ handle-unix-effect
|
||||
|= [who=@p ue=unix-effect:aquarium]
|
||||
^- (quip card:agent:mall _this)
|
||||
=^ cards piers
|
||||
?+ -.q.ue `piers
|
||||
%sleep abet-pe:handle-sleep:(pe bowl who)
|
||||
%restore abet-pe:handle-restore:(pe bowl who)
|
||||
%thus abet-pe:(handle-thus:(pe bowl who) ue)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ handle-arvo-response
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card:agent:mall _this)
|
||||
?> ?=([%i %http-response %finished *] sign-arvo)
|
||||
?> ?=([@ *] wire)
|
||||
=/ who (,@p (slav %p i.wire))
|
||||
=/ =httr:eyre
|
||||
(to-httr:iris [response-header full-file]:client-response.sign-arvo)
|
||||
=^ cards piers
|
||||
abet-pe:(take-sigh-httr:(pe bowl who) t.wire httr)
|
||||
[cards this]
|
||||
--
|
||||
79
pkg/arvo/lib/aqua-vane.hoon
Normal file
79
pkg/arvo/lib/aqua-vane.hoon
Normal file
@ -0,0 +1,79 @@
|
||||
/- aquarium
|
||||
/+ default-agent
|
||||
=, aquarium
|
||||
|%
|
||||
++ vane-handler
|
||||
$_ ^|
|
||||
|_ bowl:mall
|
||||
++ handle-unix-effect
|
||||
|~ [ship unix-effect]
|
||||
*(quip card:agent:mall _^|(..handle-unix-effect))
|
||||
::
|
||||
++ handle-arvo-response
|
||||
|~ [wire sign-arvo]
|
||||
*(quip card:agent:mall _^|(..handle-unix-effect))
|
||||
--
|
||||
--
|
||||
::
|
||||
|= handler=vane-handler
|
||||
^- agent:mall
|
||||
=| subscribed=_|
|
||||
|_ =bowl:mall
|
||||
+* this .
|
||||
def ~(. default-agent bowl this)
|
||||
++ handle-init handle-init:def
|
||||
++ handle-extract-state !>(subscribed)
|
||||
++ handle-upgrade-state
|
||||
|= old-state=vase
|
||||
`this(subscribed !<(_| old-state))
|
||||
::
|
||||
++ handle-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card:agent:mall _this)
|
||||
?. ?=(%aqua-vane-control mark)
|
||||
(handle-poke:def mark vase)
|
||||
=/ command !<(?(%subscribe %unsubscribe) vase)
|
||||
=. subscribed =(command %subscribe)
|
||||
:_ this
|
||||
?- command
|
||||
%subscribe
|
||||
%+ weld
|
||||
^- (list card:agent:mall)
|
||||
?. subscribed
|
||||
~
|
||||
[%pass /aqua %agent [our.bowl %ph] %unsubscribe ~]~
|
||||
^- (list card:agent:mall)
|
||||
[%pass /aqua %agent [our.bowl %ph] %subscribe /effects]~
|
||||
::
|
||||
%unsubscribe
|
||||
?. subscribed
|
||||
~
|
||||
[%pass /aqua %agent [our.bowl %ph] %unsubscribe ~]~
|
||||
==
|
||||
::
|
||||
++ handle-subscribe handle-subscribe:def
|
||||
++ handle-unsubscribe handle-unsubscribe:def
|
||||
++ handle-peek handle-peek:def
|
||||
++ handle-agent-response
|
||||
|= [=wire =gift:agent:mall]
|
||||
?. ?=([%subscription-update * %aqua-effects *] gift)
|
||||
(handle-agent-response:def wire gift)
|
||||
=/ afs !<(aqua-effects q.cage.gift)
|
||||
|- ^- (quip card:agent:mall _this)
|
||||
?~ ufs.afs
|
||||
`this
|
||||
=^ cards-1 handler
|
||||
(~(handle-unix-effect handler bowl) who.afs i.ufs.afs)
|
||||
=^ cards-2 this
|
||||
$(ufs.afs t.ufs.afs)
|
||||
[(welp cards-1 cards-2) this]
|
||||
::
|
||||
++ handle-arvo-response
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card:agent:mall _this)
|
||||
=^ cards handler
|
||||
(~(handle-arvo-response handler bowl) wire sign-arvo)
|
||||
[cards this]
|
||||
::
|
||||
++ handle-error handle-error:def
|
||||
--
|
||||
@ -13,13 +13,11 @@
|
||||
::
|
||||
++ handle-poke
|
||||
|= =cage
|
||||
~& "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
|
||||
~| "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
|
||||
!!
|
||||
::
|
||||
++ handle-subscribe
|
||||
|= =path
|
||||
~& "unexpected subscription to {<dap.bowl>} on path {<path>}"
|
||||
~| "unexpected subscription to {<dap.bowl>} on path {<path>}"
|
||||
!!
|
||||
::
|
||||
@ -35,8 +33,19 @@
|
||||
++ handle-agent-response
|
||||
|= [=wire =gift:agent:mall]
|
||||
?- -.gift
|
||||
%poke-ack `agent
|
||||
%subscription-ack `agent
|
||||
%poke-ack
|
||||
?~ p.gift
|
||||
`agent
|
||||
%- (slog leaf+"poke failed from {<dap.bowl>} on wire {<wire>}" u.p.gift)
|
||||
`agent
|
||||
::
|
||||
%subscription-ack
|
||||
?~ p.gift
|
||||
`agent
|
||||
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
|
||||
%- (slog tank u.p.gift)
|
||||
`agent
|
||||
::
|
||||
%subscription-close
|
||||
~| "unexpected subscription closure to {<dap.bowl>} on wire {<wire>}"
|
||||
!!
|
||||
|
||||
@ -57,28 +57,4 @@
|
||||
[%init ~]
|
||||
[%request id=@ud request=request:http]
|
||||
==
|
||||
+$ vane-move
|
||||
%+ pair bone
|
||||
$% [%peer wire dock path]
|
||||
[%pull wire dock ~]
|
||||
==
|
||||
::
|
||||
++ aqua-vane-control-handler
|
||||
|= [our=@p ost=bone subscribed=? command=?(%subscribe %unsubscribe)]
|
||||
^- (list vane-move)
|
||||
?- command
|
||||
%subscribe
|
||||
%+ weld
|
||||
^- (list vane-move)
|
||||
?. subscribed
|
||||
~
|
||||
[ost %pull /aqua [our %ph] ~]~
|
||||
^- (list vane-move)
|
||||
[ost %peer /aqua [our %ph] /effects]~
|
||||
::
|
||||
%unsubscribe
|
||||
?. subscribed
|
||||
~
|
||||
[ost %pull /aqua [our %ph] ~]~
|
||||
==
|
||||
--
|
||||
|
||||
@ -6927,7 +6927,7 @@
|
||||
::
|
||||
r.q.hiss
|
||||
==
|
||||
-- ::eyre
|
||||
-- :: html
|
||||
:: ::
|
||||
:::: ++wired :: wire formatting
|
||||
:: ::::
|
||||
|
||||
Loading…
Reference in New Issue
Block a user