gall: allow apps to run from any desk

Start with |start %desk %app-name

Everywhere in the kernel that we deal with marks, we infer the app it's
connected to and use the marks from that desk.

Also some light renaming in gall, especially path->wire and
current-agent->yoke.

Subsequent tasks:

- Dojo needs a syntax to run generators and threads from other desks
- The home desk should be split into at least a minimal base desk and
  big "userspace" desk.  Dill's initialization logic should be updated
  to handle
- |show-package, |install, and |uninstall should to be written
- Clay should have smarter handling of system versions instead of just
  ignoring what's on each desk.  It's not clear that this will work
  correctly when sys updates right now.
This commit is contained in:
Philip Monk 2021-06-18 16:13:55 -10:00
parent 7ac718a2c7
commit 87ca57c364
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
8 changed files with 283 additions and 221 deletions

View File

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %13
$: %14
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -10,12 +10,13 @@
+$ any-state
$% state
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
[%7 drum=state:drum helm=state:helm kiln=state:kiln]
[%8 drum=state:drum helm=state:helm kiln=state:kiln]
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln]
[%12 drum=state:drum helm=state:helm kiln=state:kiln]
[%7 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%8 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%9 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%10 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%11 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%12 drum=state-2:drum helm=state:helm kiln=state:kiln]
[%13 drum=state-2:drum helm=state:helm kiln=state:kiln]
==
+$ any-state-tuple
$: drum=any-state:drum

View File

@ -1,9 +1,17 @@
/- *sole
/+ sole
|%
+$ any-state $%(state)
+$ state [%2 pith-2]
+$ any-state $%(state state-2)
+$ state [%3 pith-3]
+$ state-2 [%2 pith-2]
::
++ pith-3 ::
$: eel=(set gill:gall) :: connect to
ray=(map dude:gall desk) ::
fur=(map dude:gall (unit server)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
++ pith-2 ::
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
@ -56,11 +64,11 @@
|%
++ deft-apes :: default servers
|= [our=ship lit=?]
%- ~(gas in *(set well:gall))
%- ~(gas by *(map dap=term desk))
^- (list well:gall)
:: boot all default apps off the home desk
::
=- (turn - |=(a=term home+a))
=- (turn - |=(a=term [a %home]))
^- (list term)
%+ welp
:~ %dojo
@ -219,7 +227,7 @@
++ on-load
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat old
=. sat old(- %3)
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
@ -260,7 +268,8 @@
=> (se-born | %home %settings-store)
(se-born | %home %group-view)
=? ..on-load (lte hood-version %13)
(se-born | %home %dm-hook)
=> (se-born | %home %dm-hook)
.(ray (~(gas by ray) (turn ~(tap in ray) |=(=well:gall [q.well p.well]))))
..on-load
::
++ reap-phat :: ack connect
@ -340,13 +349,12 @@
++ se-adit :: update servers
^+ this
|^
=/ servers=(list well:gall)
(sort ~(tap in ray) sort-by-priorities)
=/ servers=(list [dap=term =desk])
(sort ~(tap by ray) sort-by-priorities)
|-
?~ servers
this
=/ wel=well:gall
i.servers
=/ wel=well:gall [+ -]:i.servers
=/ =wire [%drum p.wel q.wel ~]
=/ hig=(unit (unit server))
(~(get by fur) q.wel)
@ -358,7 +366,7 @@
(se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
=. this
%- se-emit
[%pass wire %arvo %g %conf q.wel]
[%pass wire %arvo %g %conf wel]
$(servers t.servers)
::
++ priorities
@ -397,7 +405,7 @@
|- ^+ this
?~ ruf
this
?: (~(has in ray) [%home i.ruf])
?: (~(has by ray) i.ruf)
$(ruf t.ruf)
=/ wire [%drum %fade i.ruf ~]
=. this (se-emit %pass wire %arvo %g %fade i.ruf %slay)
@ -490,21 +498,21 @@
++ se-born :: new server
|= [print-on-repeat=? wel=well:gall]
^+ +>
?: (~(has in ray) wel)
?: (~(has by ray) q.wel)
?. print-on-repeat +>
(se-text "[already running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(put in ray) wel)
ray (~(put by ray) q.wel p.wel)
eel (~(put in eel) [our.hid q.wel])
==
::
++ se-fade :: delete server
|= wel=well:gall
^+ +>
?. (~(has in ray) wel)
?. (~(has by ray) q.wel)
(se-text "[fade not running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(del in ray) wel)
ray (~(del by ray) q.wel)
==
::
++ se-drop :: disconnect

View File

@ -1635,11 +1635,11 @@
$% [%boon payload=*] :: ames response
[%done error=(unit error:ames)] :: ames message (n)ack
[%onto p=(each suss tang)] :: about agent
[%unto p=sign:agent] ::
[%unto p=unto] ::
== ::
+$ task :: incoming request
$~ [%vega ~] ::
$% [%conf dap=term] :: start agent
$% [%conf =desk dap=term] :: start agent
[%deal p=sock q=term r=deal] :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
[%sear =ship] :: clear pending queues
@ -1683,6 +1683,10 @@
$% [%raw-poke =mark =noun]
task:agent
==
+$ unto
$% [%raw-fact =mark =noun]
sign:agent
==
::
:: +agent: app core
::

View File

@ -224,7 +224,7 @@
=/ myt (flop (fall tem ~))
=/ can (clan:title our)
=. tem ~
=. +> (pass / %g %conf ram)
=. +> (pass / %g %conf ram %home)
=? +> ?=(?(%earl %duke %king) can)
(ota sein %kids)
:: make kids desk publicly readable, so syncs work.
@ -276,6 +276,7 @@
[%gall %unto *]
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
%raw-fact !!
%poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%kick peer
%watch-ack ?~ p.p.+>.sih

View File

@ -736,7 +736,7 @@
:: attempt to find conversion gate to mime
::
=/ tub=(unit tube:clay)
(find-tube mark %mime)
(find-tube i.site.req mark %mime)
?~ tub (error-response 500 "no tube from {(trip mark)} to mime")
:: attempt conversion, then send results
::
@ -749,11 +749,15 @@
==
::
++ find-tube
|= [from=mark to=mark]
|= [dap=term from=mark to=mark]
^- (unit tube:clay)
?: =(from to) `(bake same vase)
=/ des=(unit (unit cage))
(do-scry %gd dap ~)
?. ?=([~ ~ *] des) ~
=+ !<(=desk q.u.u.des)
=/ tub=(unit (unit cage))
(do-scry %cc %home /[from]/[to])
(do-scry %cc desk /[from]/[to])
?. ?=([~ ~ %tube *] tub) ~
`!<(tube:clay q.u.u.tub)
::
@ -1240,8 +1244,10 @@
::NOTE these will only fail if the mark and/or json types changed,
:: since conversion failure also gets caught during first receive.
:: we can't do anything about this, so consider it unsupported.
?~ sign=(channel-event-to-sign channel-event) $
?~ jive=(sign-to-json request-id u.sign) $
=/ sign
(channel-event-to-sign u.maybe-channel request-id channel-event)
?~ sign $
?~ jive=(sign-to-json u.maybe-channel request-id u.sign) $
$(events [(event-json-to-wall id +.u.jive) events])
:: send the start event to the client
::
@ -1509,7 +1515,7 @@
:: connected, we *will* send it immediately.
::
=/ jive=(unit (quip move json))
(sign-to-json request-id sign)
(sign-to-json u.channel request-id sign)
=/ json=(unit json)
?~(jive ~ `+.u.jive)
=? moves ?=(^ jive)
@ -1591,7 +1597,7 @@
^= data
%- wall-to-octs
%+ event-json-to-wall next-id
+:(need (sign-to-json request-id %kick ~))
+:(need (sign-to-json u.channel request-id %kick ~))
::
complete=%.n
==
@ -1610,18 +1616,33 @@
^- channel-event
?. ?=(%fact -.sign) sign
[%fact [p q.q]:cage.sign]
:: +app-to-desk
::
++ app-to-desk
|= [=channel request-id=@ud]
^- (unit desk)
=/ sub (~(get by subscriptions.channel) request-id)
?~ sub
((slog leaf+"eyre: no subscription for request-id {<request-id>}" ~) ~)
=/ des=(unit (unit cage))
(rof ~ %gd [our app.u.sub da+now] ~)
?. ?=([~ ~ *] des)
((slog leaf+"eyre: no desk for app {(trip app.u.sub)}" ~) ~)
`!<(=desk q.u.u.des)
:: +channel-event-to-sign: attempt to recover a sign from a channel-event
::
++ channel-event-to-sign
~% %eyre-channel-event-to-sign ..part ~
|= event=channel-event
|= [=channel request-id=@ud event=channel-event]
^- (unit sign:agent:gall)
?. ?=(%fact -.event) `event
:: rebuild vase for fact data
::
=/ des=(unit desk) (app-to-desk channel request-id)
?~ des ~
=* have=mark mark.event
=/ val=(unit (unit cage))
(rof ~ %cb [our %home da+now] /[have])
(rof ~ %cb [our u.des da+now] /[have])
?. ?=([~ ~ *] val)
((slog leaf+"eyre: no mark {(trip have)}" ~) ~)
=+ !<(=dais:clay q.u.u.val)
@ -1633,32 +1654,35 @@
::
++ sign-to-json
~% %sign-to-json ..part ~
|= [request-id=@ud =sign:agent:gall]
|= [=channel request-id=@ud =sign:agent:gall]
^- (unit (quip move json))
:: for facts, we try to convert the result to json
::
=/ [from=(unit mark) jsyn=(unit sign:agent:gall)]
=/ [from=(unit [=desk =mark]) jsyn=(unit sign:agent:gall)]
?. ?=(%fact -.sign) [~ `sign]
?: ?=(%json p.cage.sign) [~ `sign]
:: find and use tube from fact mark to json
::
=/ des=(unit desk) (app-to-desk channel request-id)
?~ des [~ ~]
::
=* have=mark p.cage.sign
=* desc=tape "from {(trip have)} to json"
=/ convert=(unit vase)
=/ cag=(unit (unit cage))
(rof ~ %cf [our %home da+now] /[have]/json)
(rof ~ %cf [our u.des da+now] /[have]/json)
?. ?=([~ ~ *] cag) ~
`q.u.u.cag
?~ convert
((slog leaf+"eyre: no convert {desc}" ~) [~ ~])
~| "conversion failed {desc}"
[`have `[%fact %json (slym u.convert q.q.cage.sign)]]
[`[u.des have] `[%fact %json (slym u.convert q.q.cage.sign)]]
?~ jsyn ~
%- some
:- ?~ from ~
:_ ~
:^ duct %pass /conversion-cache/[u.from]
[%c %warp our %home `[%sing %f da+now /[u.from]/json]]
:^ duct %pass /conversion-cache/[mark.u.from]
[%c %warp our desk.u.from `[%sing %f da+now /[mark.u.from]/json]]
=* sign u.jsyn
=, enjs:format
%- pairs
@ -2439,8 +2463,9 @@
::
?(%poke %subscription)
?> ?=([%gall %unto *] sign)
~| wire
~| eyre-sub=wire
?> ?=([@ @ @t @ *] wire)
?< ?=(%raw-fact -.p.sign)
=* channel-id i.t.t.wire
=* request-id i.t.t.t.wire
=* extra-wire t.t.t.t.wire

View File

@ -64,7 +64,7 @@
==
:: $blocked-move: enqueued move to an agent
::
+$ blocked-move [=duct =routes move=(each deal sign:agent)]
+$ blocked-move [=duct =routes move=(each deal unto)]
:: $stats: statistics
::
:: change: how many moves this agent has processed
@ -272,6 +272,13 @@
++ mo-abet [(flop moves) gall-payload]
++ mo-pass |=(p=[wire note-arvo] mo-core(moves [[hen pass+p] moves]))
++ mo-give |=(g=gift mo-core(moves [[hen give+g] moves]))
++ mo-past
|= =(list [wire note-arvo])
?~ list
mo-core
=. mo-core (mo-pass i.list)
$(list t.list)
::
:: +mo-boot: ask %ford to build us a core for the specified agent.
::
++ mo-boot
@ -365,30 +372,39 @@
|= date=@da
^+ mo-core
=. mo-core (mo-abed system-duct.state)
=/ =wire /sys/lyv
=. mo-core (mo-pass /sys/lyv %c %warp our %home ~)
=/ =mool:clay
:- da+date
%- ~(gas in *(set [care:clay path]))
:* [%z /sys/hoon/hoon]
::
=/ sources=(jug desk [care:clay path])
%+ ~(put by *(jug desk [care:clay path])) %home
%- sy
:~ [%z /sys/hoon/hoon]
[%z /sys/arvo/hoon]
[%z /sys/lull/hoon]
[%z /sys/zuse/hoon]
[%z /sys/vane/gall/hoon]
%+ murn ~(tap by yokes.state)
|= [dap=term =yoke]
^- (unit [care:clay path])
?: ?=(%| -.agent.yoke)
~
`[%a /app/[dap]/hoon]
==
(mo-pass wire %c %warp our %home ~ %mult mool)
::
=. sources
=/ apps=(list [dap=term =yoke]) ~(tap by yokes.state)
|- ^+ sources
?~ apps
sources
=? sources ?=(%& -.agent.yoke.i.apps)
(~(put ju sources) q.beak.yoke.i.apps %a /app/[dap.i.apps]/hoon)
$(apps t.apps)
::
%- mo-past
%- zing
%+ turn ~(tap by sources)
|= [=desk paths=(set [care:clay path])]
:~ [/sys/lyv %c %warp our desk ~]
[/sys/lyv %c %warp our desk ~ %mult da+date paths]
==
:: +mo-scry-agent-cage: read $agent core from clay
::
++ mo-scry-agent-cage
|= [dap=term =case:clay]
|= [dap=term =desk =case:clay]
^- (each agent tang)
=/ bek=beak [our %home case]
=/ bek=beak [our desk case]
=/ sky (rof ~ %ca bek /app/[dap]/hoon)
?~ sky |+[leaf+"gall: {<dap>} scry blocked"]~
?~ u.sky |+[leaf+"gall: {<dap>} scry failed"]~
@ -497,35 +513,35 @@
::
++ mo-handle-sys
~/ %mo-handle-sys
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
::
?+ -.path !!
%lyv (mo-handle-sys-lyv path sign-arvo)
%era (mo-handle-sys-era path sign-arvo)
%cor (mo-handle-sys-cor path sign-arvo)
%lag (mo-handle-sys-lag path sign-arvo)
%req (mo-handle-sys-req path sign-arvo)
%way (mo-handle-sys-way path sign-arvo)
?+ -.wire !!
%lyv (mo-handle-sys-lyv wire sign-arvo)
%era (mo-handle-sys-era wire sign-arvo)
%cor (mo-handle-sys-cor wire sign-arvo)
%lag (mo-handle-sys-lag wire sign-arvo)
%req (mo-handle-sys-req wire sign-arvo)
%way (mo-handle-sys-way wire sign-arvo)
==
:: +mo-handle-sys-era: receive update about contact
::
++ mo-handle-sys-era
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
?> ?=([%jael %public-keys *] sign-arvo)
?> ?=([%era ~] path)
?> ?=([%era ~] wire)
?. ?=(%breach -.public-keys-result.sign-arvo)
mo-core
(mo-breach who.public-keys-result.sign-arvo)
:: +mo-handle-sys-cor: receive a built agent from %clay
::
++ mo-handle-sys-cor
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
::
?> ?=([%cor @ @ @ @ ~] path)
=/ [dap=term her=@ta desk=@ta dat=@ta ~] t.path
?> ?=([%cor @ @ @ @ ~] wire)
=/ [dap=term her=@ta desk=@ta dat=@ta ~] t.wire
=/ tim (slav da+dat)
=/ =beak [(slav %p her) desk da+tim]
?> ?=([?(%behn %clay) %writ *] sign-arvo)
@ -546,23 +562,22 @@
^+ mo-core
=. mo-core (mo-give %onto |+tang)
=/ =case [%da tim]
=/ =wire /sys/cor/[dap]/[her]/[desk]/(scot case)
=/ =^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
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
?> ?=([%lyv ~] path)
?> ?=([%lyv ~] wire)
?> ?=([?(%behn %clay) %wris *] sign-arvo)
=/ bek=beak [our %home p.sign-arvo]
=/ nex=(list [=care:clay =^path]) ~(tap in q.sign-arvo)
=/ nex=(list [=care:clay =path]) ~(tap in q.sign-arvo)
~> %slog.[0 leaf+"gall: reloading agents"]
~< %slog.[0 leaf+"gall: reloaded agents"]
=; cor (mo-subscribe-to-agent-builds:cor p.p.sign-arvo)
%+ roll nex
|= [[=care:clay =^path] cor=_mo-core]
|= [[=care:clay =path] cor=_mo-core]
^+ cor
:: We throw away %z results because we only have them to guarantee
:: molting. Clay will tell us if e.g. changing hoon.hoon affects
@ -570,18 +585,24 @@
::
?. =(%a care)
cor
~| path=path
=/ dap dap:;;([%app dap=@tas %hoon ~] path)
=/ rag (mo-scry-agent-cage dap p.sign-arvo)
=/ yok=(unit yoke) (~(get by yokes.state) dap)
?~ yok
~> %slog.[0 leaf+"gall: no agent to reload: {<dap>}"]
mo-core
=/ bek=beak [our q.beak.u.yok p.sign-arvo]
=/ rag (mo-scry-agent-cage dap q.bek p.sign-arvo)
?: ?=(%| -.rag)
(mean p.rag)
(mo-receive-core:cor dap bek p.rag)
:: +mo-handle-sys-lag: handle an ames %clog notification
::
++ mo-handle-sys-lag
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
::
?> ?=([%lag ~] path)
?> ?=([%lag ~] wire)
?> ?=([%ames %clog *] sign-arvo)
::
=/ agents=(list term) ~(tap in ~(key by yokes.state))
@ -598,25 +619,26 @@
::
:: TODO: what should we do if the remote nacks our %pull?
++ mo-handle-sys-req
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
::
?> ?=([%req @ @ ~] path)
=/ him (slav %p i.t.path)
=/ dap i.t.t.path
?> ?=([%req @ @ ~] wire)
=/ him (slav %p i.t.wire)
=/ dap i.t.t.wire
::
?> ?=([?(%gall %behn) %unto *] sign-arvo)
=/ =sign:agent +>.sign-arvo
=/ =unto +>.sign-arvo
::
?- -.sign
?- -.unto
%raw-fact ~|([%gall-raw-req wire] !!)
%poke-ack
=/ err=(unit error:ames)
?~ p.sign ~
`[%poke-ack u.p.sign]
?~ p.unto ~
`[%poke-ack u.p.unto]
(mo-give %done err)
::
%fact
=+ [mark noun]=[p q.q]:cage.sign
=+ [mark noun]=[p q.q]:cage.unto
(mo-give %boon %d mark noun)
::
%kick
@ -624,8 +646,8 @@
::
%watch-ack
=/ err=(unit error:ames)
?~ p.sign ~
`[%watch-ack u.p.sign]
?~ p.unto ~
`[%watch-ack u.p.unto]
(mo-give %done err)
==
:: +mo-handle-sys-way: handle response to outgoing remote request
@ -699,19 +721,19 @@
::
++ mo-handle-use
~/ %mo-handle-use
|= [=path =sign-arvo]
|= [=wire =sign-arvo]
^+ mo-core
::
?. ?=([@ @ @ *] path)
~& [%mo-handle-use-bad-path path]
?. ?=([@ @ @ *] wire)
~& [%mo-handle-use-bad-wire wire]
!!
::
=/ dap=term i.path
=/ dap=term i.wire
=/ yoke (~(get by yokes.state) dap)
?~ yoke
%- (slog leaf+"gall: {<dap>} dead, got {<+<.sign-arvo>}" ~)
mo-core
?. =(nonce.u.yoke i.t.path)
?. =(nonce.u.yoke i.t.wire)
%- (slog leaf+"gall: got old {<+<.sign-arvo>} for {<dap>}" ~)
mo-core
?. ?=([?(%gall %behn) %unto *] sign-arvo)
@ -719,30 +741,30 @@
%- (slog leaf+"gall: {<dap>} dozing, dropping {<+<.sign-arvo>}" ~)
mo-core
=/ app
=/ =ship (slav %p i.t.t.path)
=/ =ship (slav %p i.t.t.wire)
=/ =routes [disclosing=~ attributing=ship]
(ap-abed:ap dap routes)
::
=. app (ap-generic-take:app t.t.t.path sign-arvo)
=. app (ap-generic-take:app t.t.t.wire sign-arvo)
ap-abet:app
?> ?=([%out @ @ *] t.t.path)
=/ =ship (slav %p i.t.t.t.path)
?> ?=([%out @ @ *] t.t.wire)
=/ =ship (slav %p i.t.t.t.wire)
=/ =routes [disclosing=~ attributing=ship]
=/ =sign:agent +>.sign-arvo
=/ =unto +>.sign-arvo
?: ?=(%| -.agent.u.yoke)
=/ blocked=(qeu blocked-move)
=/ waiting (~(get by blocked.state) dap)
=/ deals (fall waiting *(qeu blocked-move))
=/ deal [hen routes |+sign]
=/ deal [hen routes |+unto]
(~(put to deals) deal)
::
%- (slog leaf+"gall: {<dap>} dozing, got {<-.sign>}" ~)
%- (slog leaf+"gall: {<dap>} dozing, got {<-.unto>}" ~)
%_ mo-core
blocked.state (~(put by blocked.state) dap blocked)
==
=/ app (ap-abed:ap dap routes)
=. app
(ap-specific-take:app t.t.path sign)
(ap-specific-take:app t.t.wire unto)
ap-abet:app
:: +mo-clear-queue: clear blocked tasks from the specified running agent.
::
@ -758,7 +780,7 @@
?: =(~ blocked)
=. blocked.state (~(del by blocked.state) dap)
mo-core
=^ [=duct =routes blocker=(each deal sign:agent)] blocked
=^ [=duct =routes blocker=(each deal unto)] blocked
~(get to blocked)
=/ =move
=/ =sock [attributing.routes our]
@ -803,21 +825,10 @@
?- style
%slay mo-core(yokes.state (~(del by yokes.state) dap))
%idle mo-core
%jolt (mo-boot dap our %home)
%jolt (mo-boot dap our q.beak:(~(got by yokes.state) dap))
==
=? mo-core !?=(%jolt style) (mo-subscribe-to-agent-builds now)
mo-core
:: +mo-beak: assemble a beak for the specified agent.
::
++ mo-beak
|= dap=term
^- beak
?^ yoke=(~(get by yokes.state) dap)
beak.u.yoke
:: XX this fallback is necessary, as .term could be either the source
:: or the destination app. ie, it might not exist locally ...
::
[our %home %da now]
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
::
++ mo-peek
@ -837,7 +848,8 @@
::
%raw-poke
=/ =case:clay da+now
=/ sky (rof ~ %cb [our %home case] /[mark.deal])
=/ =desk q.beak:(~(got by yokes.state) dap)
=/ sky (rof ~ %cb [our desk case] /[mark.deal])
?- sky
?(~ [~ ~])
=/ ror "gall: raw-poke fail :{(trip dap)} {<mark.deal>}"
@ -851,7 +863,7 @@
(mo-give %unto %poke-ack `[leaf+ror p.res])
=. mo-core
%+ mo-pass /nowhere
[%c %warp our %home ~ %sing %b case /[mark.deal]]
[%c %warp our desk ~ %sing %b case /[mark.deal]]
(mo-apply-sure dap routes [%poke mark.deal p.res])
==
::
@ -859,7 +871,8 @@
=/ =case:clay da+now
=/ =mars:clay [p.cage mark]:deal
=/ mars-path /[a.mars]/[b.mars]
=/ sky (rof ~ %cc [our %home case] mars-path)
=/ =desk q.beak:(~(got by yokes.state) dap)
=/ sky (rof ~ %cc [our desk case] mars-path)
?- sky
?(~ [~ ~])
=/ ror "gall: poke cast fail :{(trip dap)} {<mars>}"
@ -873,7 +886,7 @@
(mo-give %unto %poke-ack `[leaf+ror p.res])
=. mo-core
%+ mo-pass /nowhere
[%c %warp our %home ~ %sing %c case /[a.mars]/[b.mars]]
[%c %warp our desk ~ %sing %c case /[a.mars]/[b.mars]]
(mo-apply-sure dap routes [%poke mark.deal p.res])
==
==
@ -935,31 +948,12 @@
++ mo-handle-ames-response
|= =ames-response
^+ mo-core
?- -.ames-response
:: %d: diff; ask clay to validate .noun as .mark
::
%d
=/ =case:clay da+now
=/ sky (rof ~ %cb [our %home case] /[mark.ames-response])
?- sky
?(~ [~ ~])
(mean leaf+"gall: ames mark fail {<mark.ames-response>}" ~)
:: %d: diff; ask clay to validate .noun as .mark
:: %x: kick; tell agent the publisher canceled the subscription
::
[~ ~ *]
=+ !<(=dais:clay q.u.u.sky)
=/ res (mule |.((vale:dais noun.ames-response)))
?: ?=(%| -.res)
(mean leaf+"gall: ames vale fail {<mark.ames-response>}" p.res)
=. mo-core
%+ mo-pass /nowhere
[%c %warp our %home ~ %sing %b case /[mark.ames-response]]
(mo-give %unto %fact mark.ames-response p.res)
==
::
:: %x: kick; tell agent the publisher canceled the subscription
::
%x
(mo-give %unto %kick ~)
?- -.ames-response
%d (mo-give %unto %raw-fact mark.ames-response noun.ames-response)
%x (mo-give %unto %kick ~)
==
:: +ap: agent engine
::
@ -973,7 +967,7 @@
agent-duct=duct
agent-moves=(list move)
agent-config=(list (each suss tang))
current-agent=yoke
=yoke
==
++ ap-core .
:: +ap-abed: initialise state for an agent, with the supplied routes.
@ -991,27 +985,27 @@
++ ap-abut
|= [dap=term =egg]
^+ ap-core
=/ =yoke
=/ yak=^yoke
?: ?=(%| -.old-state.egg)
egg
=/ res (mo-scry-agent-cage dap da+now)
=/ res (mo-scry-agent-cage dap q.beak.egg da+now)
?: ?=(%| -.res)
(mean p.res)
egg(p.old-state `agent`p.res)
=/ =routes [disclosing=~ attributing=our]
(ap-yoke dap routes yoke)
(ap-yoke dap routes yak)
:: +ap-yoke: initialize agent state, starting from a $yoke
::
++ ap-yoke
|= [dap=term =routes =yoke]
|= [dap=term =routes yak=^yoke]
^+ ap-core
=. stats.yoke
:+ +(change.stats.yoke)
(shaz (mix (add dap change.stats.yoke) eny))
=. stats.yak
:+ +(change.stats.yak)
(shaz (mix (add dap change.stats.yak) eny))
now
=. agent-name dap
=. agent-routes routes
=. current-agent yoke
=. yoke yak
=. agent-duct hen
ap-core
:: +ap-abet: resolve moves.
@ -1019,7 +1013,7 @@
++ ap-abet
^+ mo-core
::
=/ running (~(put by yokes.state) agent-name current-agent)
=/ running (~(put by yokes.state) agent-name yoke)
=/ moves
=/ giver |=(report=(each suss tang) [hen %give %onto report])
=/ from-suss (turn agent-config giver)
@ -1039,15 +1033,15 @@
?- style
%jolt ap-core
%idle
=. agent.current-agent |+on-save:ap-agent-core
=. agent.yoke |+on-save:ap-agent-core
ap-core
::
%slay
=/ out=(list [[=wire =ship =term] ? =path])
~(tap by outbound.watches.current-agent)
~(tap by outbound.watches.yoke)
=/ inbound-paths=(set path)
%- silt
%+ turn ~(tap by inbound.watches.current-agent)
%+ turn ~(tap by inbound.watches.yoke)
|= [=duct =ship =path]
path
=/ will=(list card:agent:gall)
@ -1055,7 +1049,7 @@
?: =(~ inbound-paths)
~
[%give %kick ~(tap in inbound-paths) ~]~
%+ turn ~(tap by outbound.watches.current-agent)
%+ turn ~(tap by outbound.watches.yoke)
|= [[=wire =ship =term] ? =path]
[%pass wire %agent [ship term] %leave ~]
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
@ -1100,17 +1094,16 @@
%- zing
%+ turn ducts
|= =duct
^- (list move)
~? &(=(duct system-duct.state) !=(agent-name %hood))
[%agent-giving-on-system-duct agent-name -.gift]
^- (list move)
=/ =mark
(~(gut by marks.current-agent) duct p.cage)
=/ =mark (~(gut by marks.yoke) duct p.cage)
::
?: =(mark p.cage)
[duct %give %unto %fact cage.gift]~
=/ =mars:clay [p.cage mark]
=/ =case:clay da+now
=/ bek=beak [our %home case]
=/ bek=beak [our q.beak.yoke case]
=/ mars-path /[a.mars]/[b.mars]
=/ sky (rof ~ %cc bek mars-path)
?- sky
@ -1124,7 +1117,9 @@
?: ?=(%| -.res)
%- (slog leaf+"watch-as fact conversion failure" p.res)
(ap-kill-up-slip duct)
:~ [duct %pass /nowhere %c %warp our %home ~ %sing %c case mars-path]
:~ :* duct %pass /nowhere %c %warp our q.beak.yoke ~
%sing %c case mars-path
==
[duct %give %unto %fact b.mars p.res]
==
==
@ -1139,7 +1134,7 @@
%huck [%out (scot %p ship.neet) name.neet wire]
%arvo [(scot %p attributing.agent-routes) wire]
==
=. wire [%use agent-name nonce.current-agent wire]
=. wire [%use agent-name nonce.yoke wire]
=/ =note-arvo
?- -.neet
%arvo note-arvo.neet
@ -1154,7 +1149,7 @@
|= =ship
^+ ap-core
=/ in=(list [=duct =^ship =path])
~(tap by inbound.watches.current-agent)
~(tap by inbound.watches.yoke)
|- ^+ ap-core
?^ in
=? ap-core =(ship ship.i.in)
@ -1163,7 +1158,7 @@
$(in t.in)
::
=/ out=(list [[=wire =^ship =term] ? =path])
~(tap by outbound.watches.current-agent)
~(tap by outbound.watches.yoke)
|- ^+ ap-core
?~ out
ap-core
@ -1186,7 +1181,7 @@
^+ ap-core
::
=/ in=(list [=duct =^ship =path])
~(tap by inbound.watches.current-agent)
~(tap by inbound.watches.yoke)
|- ^+ ap-core
?~ in ap-core
::
@ -1197,8 +1192,8 @@
:: +ap-agent-core: agent core with current bowl and state
::
++ ap-agent-core
?> ?=(%& -.agent.current-agent)
~(. p.agent.current-agent ap-construct-bowl)
?> ?=(%& -.agent.yoke)
~(. p.agent.yoke ap-construct-bowl)
:: +ap-ducts-from-paths: get ducts subscribed to paths
::
++ ap-ducts-from-paths
@ -1207,7 +1202,7 @@
?~ target-paths
?~ target-ship
~[agent-duct]
%+ murn ~(tap by inbound.watches.current-agent)
%+ murn ~(tap by inbound.watches.yoke)
|= [=duct =ship =path]
^- (unit ^duct)
?: =(target-ship `ship)
@ -1222,7 +1217,7 @@
++ ap-ducts-from-path
|= [target-path=path target-ship=(unit ship)]
^- (list duct)
%+ murn ~(tap by inbound.watches.current-agent)
%+ murn ~(tap by inbound.watches.yoke)
|= [=duct =ship =path]
^- (unit ^duct)
?: ?& =(target-path path)
@ -1276,7 +1271,7 @@
=/ tub=(unit tube:clay)
?: =(have want) `(bake same ^vase)
=/ tuc=(unit (unit cage))
(rof ~ %cc [our %home da+now] /[have]/[want])
(rof ~ %cc [our q.beak.yoke da+now] /[have]/[want])
?. ?=([~ ~ *] tuc) ~
`!<(tube:clay q.u.u.tuc)
?~ tub
@ -1294,14 +1289,21 @@
?: is-ok
ap-core
(ap-kill-down wire [other-ship other-agent])
:: +ap-move: send move
::
++ ap-move
|= =(list move)
ap-core(agent-moves (weld (flop list) agent-moves))
:: +ap-give: return result.
::
++ ap-give
|= =gift:agent
^+ ap-core
=/ internal-moves
(weld (ap-from-internal %give gift) agent-moves)
ap-core(agent-moves internal-moves)
(ap-move (ap-from-internal %give gift))
:: +ap-pass: request action.
::
++ ap-pass
|= [=path =neet]
(ap-move (ap-from-internal %pass path neet))
:: +ap-construct-bowl: set up bowl.
::
++ ap-construct-bowl
@ -1310,22 +1312,14 @@
attributing.agent-routes :: guest
agent-name :: agent
== ::
:* wex=outbound.watches.current-agent :: outgoing
sup=inbound.watches.current-agent :: incoming
:* wex=outbound.watches.yoke :: outgoing
sup=inbound.watches.yoke :: incoming
== ::
:* act=change.stats.current-agent :: tick
eny=eny.stats.current-agent :: nonce
now=time.stats.current-agent :: time
byk=beak.current-agent :: source
:* act=change.stats.yoke :: tick
eny=eny.stats.yoke :: nonce
now=time.stats.yoke :: time
byk=beak.yoke :: source
== ==
:: +ap-pass: request action.
::
++ ap-pass
|= [=path =neet]
^+ ap-core
=/ internal-moves
(ap-from-internal %pass path neet)
ap-core(agent-moves (weld internal-moves agent-moves))
:: +ap-reinstall: reinstall.
::
++ ap-reinstall
@ -1333,11 +1327,11 @@
|= =agent
^+ ap-core
=/ old-state=vase
?: ?=(%& -.agent.current-agent)
?: ?=(%& -.agent.yoke)
on-save:ap-agent-core
p.agent.current-agent
p.agent.yoke
=^ error ap-core
(ap-install(agent.current-agent &+agent) `old-state)
(ap-install(agent.yoke &+agent) `old-state)
?~ error
ap-core
(mean >%load-failed< u.error)
@ -1346,7 +1340,7 @@
++ ap-subscribe-as
|= [=mark =path]
^+ ap-core
=. marks.current-agent (~(put by marks.current-agent) agent-duct mark)
=. marks.yoke (~(put by marks.yoke) agent-duct mark)
(ap-subscribe path)
:: +ap-subscribe: apply %watch.
::
@ -1355,8 +1349,8 @@
|= pax=path
^+ ap-core
=/ incoming [attributing.agent-routes pax]
=. inbound.watches.current-agent
(~(put by inbound.watches.current-agent) agent-duct incoming)
=. inbound.watches.yoke
(~(put by inbound.watches.yoke) agent-duct incoming)
=^ maybe-tang ap-core
%+ ap-ingest %watch-ack |.
(on-watch:ap-agent-core pax)
@ -1398,7 +1392,7 @@
:: +ap-specific-take: specific take.
::
++ ap-specific-take
|= [=wire =sign:agent]
|= [=wire =unto]
^+ ap-core
~| wire=wire
?> ?=([%out @ @ *] wire)
@ -1406,13 +1400,31 @@
=/ other-agent i.t.t.wire
=/ =dock [other-ship other-agent]
=/ agent-wire t.t.t.wire
::
=^ =sign:agent ap-core
?. ?=(%raw-fact -.unto)
[unto ap-core]
=/ =case:clay da+now
=/ sky (rof ~ %cb [our q.beak.yoke case] /[mark.unto])
?. ?=([~ ~ *] sky)
(mean leaf+"gall: ames mark fail {<mark.unto>}" ~)
::
=+ !<(=dais:clay q.u.u.sky)
=/ res (mule |.((vale:dais noun.unto)))
?: ?=(%| -.res)
(mean leaf+"gall: ames vale fail {<mark.unto>}" p.res)
:- [%fact mark.unto p.res]
%- ap-move :_ ~
:^ hen %pass /nowhere
[%c %warp our q.beak.yoke ~ %sing %b case /[mark.unto]]
::
:: if subscription ack or close, handle before calling user code
::
=? outbound.watches.current-agent ?=(%kick -.sign)
%- ~(del by outbound.watches.current-agent)
=? outbound.watches.yoke ?=(%kick -.sign)
%- ~(del by outbound.watches.yoke)
[agent-wire dock]
?: ?& ?=(%watch-ack -.sign)
!(~(has by outbound.watches.current-agent) [agent-wire dock])
!(~(has by outbound.watches.yoke) [agent-wire dock])
==
%- %: slog
leaf+"{<agent-name>}: got ack for nonexistent subscription"
@ -1422,11 +1434,11 @@
==
ap-core
::
=? outbound.watches.current-agent ?=(%watch-ack -.sign)
=? outbound.watches.yoke ?=(%watch-ack -.sign)
?^ p.sign
%- ~(del by outbound.watches.current-agent)
%- ~(del by outbound.watches.yoke)
[agent-wire dock]
%+ ~(jab by outbound.watches.current-agent) [agent-wire dock]
%+ ~(jab by outbound.watches.yoke) [agent-wire dock]
|= [acked=? =path]
=. .
?. acked
@ -1484,8 +1496,8 @@
^+ ap-core
::
%= ap-core
inbound.watches.current-agent
(~(del by inbound.watches.current-agent) agent-duct)
inbound.watches.yoke
(~(del by inbound.watches.yoke) agent-duct)
==
:: +ap-load-delete: load delete.
::
@ -1493,13 +1505,13 @@
^+ ap-core
::
=/ maybe-incoming
(~(get by inbound.watches.current-agent) agent-duct)
(~(get by inbound.watches.yoke) agent-duct)
?~ maybe-incoming
ap-core
::
=/ incoming u.maybe-incoming
=. inbound.watches.current-agent
(~(del by inbound.watches.current-agent) agent-duct)
=. inbound.watches.yoke
(~(del by inbound.watches.yoke) agent-duct)
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
@ -1603,9 +1615,9 @@
?: ?=(%| -.result)
`ap-core
::
=. agent.current-agent &++.p.result
=. agent.yoke &++.p.result
=/ moves (zing (turn -.p.result ap-from-internal))
=. inbound.watches.current-agent
=. inbound.watches.yoke
(ap-handle-kicks moves)
(ap-handle-peers moves)
:: +ap-handle-kicks: handle cancels of inbound.watches
@ -1624,7 +1636,7 @@
::
=/ quit-map=bitt
(malt (turn quits |=(=duct [duct *[ship path]])))
(~(dif by inbound.watches.current-agent) quit-map)
(~(dif by inbound.watches.yoke) quit-map)
:: +ap-handle-peers: handle new outbound.watches
::
++ ap-handle-peers
@ -1641,8 +1653,8 @@
?> ?=([%use @ @ %out @ @ *] wire)
=/ short-wire t.t.t.t.t.t.wire
=/ =dock [q.p q]:q.move.move
=. outbound.watches.current-agent
(~(del by outbound.watches.current-agent) [short-wire dock])
=. outbound.watches.yoke
(~(del by outbound.watches.yoke) [short-wire dock])
$(moves t.moves, new-moves [move new-moves])
?. ?=([* %pass * %g %deal * * ?(%watch %watch-as) *] move)
$(moves t.moves, new-moves [move new-moves])
@ -1655,17 +1667,17 @@
%watch path.r.q.move.move
%watch-as path.r.q.move.move
==
?: (~(has by outbound.watches.current-agent) short-wire dock)
?: (~(has by outbound.watches.yoke) short-wire dock)
=. ap-core
=/ =tang
~[leaf+"subscribe wire not unique" >agent-name< >short-wire< >dock<]
=/ have
(~(got by outbound.watches.current-agent) short-wire dock)
(~(got by outbound.watches.yoke) short-wire dock)
%- (slog >out=have< tang)
(ap-error %watch-not-unique tang) :: reentrant, maybe bad?
$(moves t.moves)
=. outbound.watches.current-agent
(~(put by outbound.watches.current-agent) [short-wire dock] [| path])
=. outbound.watches.yoke
(~(put by outbound.watches.yoke) [short-wire dock] [| path])
$(moves t.moves, new-moves [move new-moves])
--
--
@ -1683,7 +1695,7 @@
::
=/ mo-core (mo-abed:mo duct)
?- -.task
%conf mo-abet:(mo-boot:mo-core dap.task our %home)
%conf mo-abet:(mo-boot:mo-core dap.task our desk.task)
%deal
=/ [=sock =term =deal] [p q r]:task
?. =(q.sock our)
@ -1753,6 +1765,16 @@
==
[~ ~ noun+!>((~(has by yokes.state) dap))]
::
?: ?& =(%d care)
=(~ path)
=([%$ %da now] coin)
=(our ship)
==
=/ yok=(unit yoke) (~(get by yokes.state) dap)
?~ yok
[~ ~]
[~ ~ desk+!>(q.beak.u.yok)]
::
?. =(our ship)
~
?. =([%$ %da now] coin)

View File

@ -563,7 +563,8 @@
+>.$
::
[%gall %unto *]
?- +>-.hin
?- +>-.hin
%raw-fact !!
%kick ~|([%jael-unexpected-quit tea hin] !!)
%poke-ack
?~ p.p.+>.hin

View File

@ -33,7 +33,7 @@
=/ ship ~nec
::
=/ call-args
=/ =task:gall [%conf dap]
=/ =task:gall [%conf dap %home]
[duct task]
::
=/ =move:gall-gate