gall: implement local provenance

This commit is contained in:
Tinnus Napbus 2023-05-23 01:12:09 +12:00
parent 58aed9ccfa
commit de51f74dc2
13 changed files with 188 additions and 131 deletions

View File

@ -1 +1 @@
[%zuse 413]
[%zuse 412]

View File

@ -3,7 +3,7 @@
|%
+| %global
::
++ arvo %238
++ arvo %237
::
:: $arch: node identity
:: $axal: fundamental node, recursive (trie)
@ -111,6 +111,7 @@
|$ [a]
$~ =>(~ |~(* ~))
$- $: lyc=gang :: leakset
pov=path :: provenance
omen :: perspective, path
== ::
%- unit :: ~: unknown
@ -118,7 +119,7 @@
(cask a) ::
+$ roon :: partial namespace
$~ =>(~ |~(* ~))
$- [lyc=gang car=term bem=beam]
$- [lyc=gang pov=path car=term bem=beam]
(unit (unit cage))
+$ root $-(^ (unit (unit)))
+$ view $@(term [way=term car=term]) :: perspective
@ -207,9 +208,9 @@
==
+$ heir
$% $: %grub
$% [?(%240 %239 %238) =grub]
$% [?(%240 %239 %238 %237) =grub]
== ==
[?(%240 %239 %238) =debt =soul]
[?(%240 %239 %238 %237) =debt =soul]
==
+$ plan (pair germ (list move))
+$ soul
@ -342,13 +343,13 @@
::
++ look
~/ %look
|= [rof=roof lyc=gang]
|= [rof=roof lyc=gang pov=path]
^- root
~/ %in
|= [ref=* raw=*]
?~ pax=((soft path) raw) ~
?~ mon=(de-omen u.pax) ~
?~ dat=(rof lyc u.mon) ~
?~ dat=(rof lyc pov u.mon) ~
?~ u.dat [~ ~]
=* vax q.u.u.dat
?. ?& ?=(^ ref)
@ -1101,7 +1102,7 @@
++ peek
~/ %peek
^- rook
|= [lyc=gang omen]
|= [lyc=gang pov=path omen]
^- (unit (unit (cask meta)))
:: namespace reads receive no entropy
::
@ -1113,7 +1114,7 @@
~> %mean.'peek: pull failed'
(~(slap wa sac) rig [%limb %scry])
::
=/ mas=[gang view beam] [lyc vis bem]
=/ mas=[gang path view beam] [lyc pov vis bem]
::
=^ pro sac
~> %mean.'peek: call failed'
@ -1373,7 +1374,7 @@
|= [nam=term =vane]
=; mas=(list mass)
nam^|+(welp mas [dot+&+q.vase typ+&+p.vase sac+&+worm ~]:vane)
?~ met=(peek [~ ~] [nam %x] bem) ~
?~ met=(peek [~ ~] / [nam %x] bem) ~
?~ u.met ~
~| mass+nam
;;((list mass) q.q.u.u.met)
@ -1381,7 +1382,7 @@
::
++ peek
^- rook
|= [lyc=gang omen]
|= [lyc=gang pov=path omen]
^- (unit (unit (cask meta)))
:: vane and care may be concatenated
::
@ -1392,12 +1393,12 @@
[(end 3 vis) (rsh 3 vis)]
::
?: ?=(%$ way)
(peek:pith lyc car bem)
(peek:pith lyc pov car bem)
::
=. way (grow way)
?~ van=(~(get by van.mod) way)
~
%. [lyc car bem]
%. [lyc pov car bem]
peek:spin:(~(plow va [vil u.van]) now peek)
:: +call: advance to target
::
@ -1552,7 +1553,7 @@
::
++ peek
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
?. ?| =(our p.bem)
?=(%$ q.bem)
@ -1764,7 +1765,7 @@
::
=. sol
?- -.hir
?(%240 %239 %238) soul.hir
?(%240 %239 %238 %237) soul.hir
==
:: clear compiler caches
::
@ -1805,7 +1806,7 @@
==
::
?~ hap ~
=/ pro (~(peek le:part [pit vil] sol) lyc [vis bem]:u.hap)
=/ pro (~(peek le:part [pit vil] sol) lyc / [vis bem]:u.hap)
?: |(?=(~ pro) ?=(~ u.pro)) ~
=/ dat=(cask) [p q.q]:u.u.pro
?. pat.u.hap `dat

View File

@ -4,7 +4,7 @@
=> ..part
~% %lull ..part ~
|%
++ lull %324
++ lull %323
:: :: ::
:::: :: :: (1) models
:: :: ::
@ -462,7 +462,7 @@
+$ rift @ud :: ship continuity
+$ mime (pair mite octs) :: mimetyped data
+$ octs (pair @ud @) :: octet-stream
+$ sock (pair ship ship) :: outgoing [our his]
+$ sock (trel ship ship path) :: [src dest prov]
+$ stub (list (pair stye (list @c))) :: styled unicode
+$ stye (pair (set deco) (pair tint tint)) :: decos/bg/fg
+$ styl %+ pair (unit deco) :: cascading style
@ -2595,6 +2595,7 @@
$: $: our=ship :: host
src=ship :: guest
dap=term :: agent
sap=path :: provenance
== ::
$: wex=boat :: outgoing subs
sup=bitt :: incoming subs

View File

@ -1762,7 +1762,7 @@
++ do-rift
=/ =rift
=- ~|(%no-rift (,@ q.q:(need (need -))))
(rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])
(rof ~ /ames %j `beam`[[our %rift %da now] /(scot %p our)])
?: =(rift rift.ames-state)
event-core
~& "ames: fixing rift from {<rift.ames-state>} to {<rift>}"
@ -1787,7 +1787,7 @@
=/ tim
;; (list [@da ^duct])
=< q.q %- need %- need
(rof ~ %bx [[our %$ da+now] /debug/timers])
(rof ~ /ames %bx [[our %$ da+now] /debug/timers])
(skim tim |=([@da hen=^duct] ?=([[%ames ?(%pump %recork) *] *] hen)))
::
:: set timers for flows that should have one set but don't
@ -2372,7 +2372,7 @@
=| =point
=. life.point life
=. keys.point (my [life crypto-suite public-key]~)
=. sponsor.point `(^^sein:title rof our now ship)
=. sponsor.point `(^^sein:title rof /ames our now ship)
::
(on-publ-full (my [ship point]~))
::
@ -2513,7 +2513,7 @@
=. sponsor.peer-state
?^ sponsor.point
u.sponsor.point
(^^sein:title rof our now ship)
(^^sein:title rof /ames our now ship)
:: automatically set galaxy route, since unix handles lookup
::
=? route.peer-state ?=(%czar (clan:title ship))
@ -2541,7 +2541,7 @@
=/ turfs
;; (list turf)
=< q.q %- need %- need
(rof ~ %j `beam`[[our %turf %da now] /])
(rof ~ /ames %j `beam`[[our %turf %da now] /])
::
(emit unix-duct.ames-state %give %turf turfs)
:: +on-vega: handle kernel reload
@ -4638,7 +4638,7 @@
?: ?=(%pawn (clan:title ship)) 0
;; @ud
=< q.q %- need %- need
(rof ~ %j `beam`[[our %rift %da now] /(scot %p ship)])
(rof ~ /ames %j `beam`[[our %rift %da now] /(scot %p ship)])
:- -.ship-state
:_ +.peer-state
=, -.peer-state
@ -4720,7 +4720,8 @@
|= old=ames-state-12
^- ames-state-13
=+ !< =rift
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
=/ =beam [[our %rift %da now] /(scot %p our)]
q:(need (need (rof ~ /ames %j beam)))
=+ pk=sec:ex:crypto-core.old
:* peers=(~(run by peers.old) ship-state-12-to-13)
unix-duct.old
@ -4762,7 +4763,7 @@
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem
@ -4844,7 +4845,7 @@
?: =(our u.who)
~
?. ?=([~ %known *] peer)
=/ sax (rof ~ %j `beam`[[our %saxo %da now] /(scot %p u.who)])
=/ sax (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p u.who)])
?. ?=([~ ~ *] sax)
~
=/ gal (rear ;;((list ship) q.q.u.u.sax))
@ -4914,19 +4915,19 @@
=/ van ?@(vis.nom (end 3 vis.nom) way.vis.nom)
?+ van ~
%c
=+ pem=(rof lyc nom(vis %cp))
=+ pem=(rof lyc /ames nom(vis %cp))
?. ?=(^ pem) ~
?. ?=(^ u.pem) ~
~| u.u.pem
=+ per=!<([r=dict:clay w=dict:clay] q.u.u.pem)
?. =([%black ~ ~] rul.r.per) ~
(en-hunk (rof ~ nom))
(en-hunk (rof ~ /ames nom))
::
%g
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
%- en-hunk
?+ kyr ~
%x (rof ~ nom)
%x (rof ~ /ames nom)
==
==
::

View File

@ -235,7 +235,7 @@
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem

View File

@ -5869,7 +5869,7 @@
++ scry :: inspect
~/ %clay-scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* scry-loop $
|^

View File

@ -104,7 +104,7 @@
::
%seat
%^ pass /seat %g
:+ %deal [our our]
:+ %deal [our our /dill]
[%hood %poke %kiln-install !>([desk.kyz our desk.kyz])]
==
::
@ -129,7 +129,7 @@
::
++ deal :: pass to %gall
|= [=wire =deal:gall]
(pass wire [%g %deal [our our] ram deal])
(pass wire [%g %deal [our our /dill] ram deal])
::
++ pass :: pass note
|= [=wire =note]
@ -146,7 +146,7 @@
++ sponsor
^- ship
=/ dat=(unit (unit cage))
(rof `[our ~ ~] j/[[our sein/da/now] /(scot %p our)])
(rof `[our ~ ~] /dill j/[[our sein/da/now] /(scot %p our)])
;;(ship q.q:(need (need dat)))
::
++ init :: initialize
@ -479,7 +479,7 @@
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem
@ -525,9 +525,10 @@
:: only the new-style subscription.
::
=/ hey (need hey.all.lax)
:* [hey %pass / %g %deal [our our] %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal [our our] %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal [our our] %hood %watch [%dill %$ ~]]
=/ =sock [our our /dill]
:* [hey %pass / %g %deal sock %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal sock %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal sock %hood %watch [%dill %$ ~]]
moz
==
=. egg.all.lax |

View File

@ -726,12 +726,12 @@
%gen
=/ bek=beak [our desk.generator.action da+now]
=/ sup=spur path.generator.action
=/ ski (rof ~ %ca bek sup)
=/ ski (rof ~ /eyre %ca bek sup)
=/ cag=cage (need (need ski))
?> =(%vase p.cag)
=/ gat=vase !<(vase q.cag)
=/ res=toon
%- mock :_ (look rof ~)
%- mock :_ (look rof ~ /eyre)
:_ [%9 2 %0 1] |.
%+ slam
%+ slam gat
@ -899,7 +899,7 @@
++ do-scry
|= [care=term =desk =path]
^- (unit (unit cage))
(rof ~ care [our desk da+now] path)
(rof ~ /eyre care [our desk da+now] path)
::
++ error-response
|= [status=@ud =tape]
@ -913,12 +913,12 @@
|= [app=term =inbound-request:eyre]
^- (list move)
:~ :* duct %pass /watch-response/[eyre-id]
%g %deal [our our] app
%g %deal [our our /eyre] app
%watch /http-response/[eyre-id]
==
::
:* duct %pass /run-app-request/[eyre-id]
%g %deal [our our] app
%g %deal [our our /eyre] app
%poke %handle-http-request
!>(`[@ta inbound-request:eyre]`[eyre-id inbound-request])
==
@ -942,7 +942,7 @@
:_ ~
%- (trace 1 |.("leaving subscription to {<app.action.u.connection>}"))
:* duct %pass /watch-response/[eyre-id]
%g %deal [our our] app.action.u.connection
%g %deal [our our /eyre] app.action.u.connection
%leave ~
==
::
@ -1185,7 +1185,7 @@
++ code
^- @ta
=/ res=(unit (unit cage))
(rof ~ %j [our %code da+now] /(scot %p our))
(rof ~ /eyre %j [our %code da+now] /(scot %p our))
(rsh 3 (scot %p ;;(@ q.q:(need (need res)))))
:: +session-cookie-string: compose session cookie
::
@ -1554,11 +1554,12 @@
?(%poke %poke-json)
::
=. gall-moves
=/ =wire /channel/poke/[channel-id]/(scot %ud request-id.i.requests)
:_ gall-moves
^- move
:^ duct %pass /channel/poke/[channel-id]/(scot %ud request-id.i.requests)
:^ duct %pass wire
=, i.requests
:* %g %deal `sock`[our ship] app
:* %g %deal `sock`[our ship /eyre] app
^- task:agent:gall
:+ %poke-as mark
?- -.i.requests
@ -1579,7 +1580,7 @@
:^ duct %pass
(subscription-wire channel-id request-id ship app)
%- (trace 1 |.("subscribing to {<app>} on {<path>}"))
:* %g %deal [our ship] app
:* %g %deal [our ship /eyre] app
`task:agent:gall`[%watch path]
==
::
@ -1616,7 +1617,7 @@
:^ duc %pass
(subscription-wire channel-id subscription-id.i.requests ship app)
%- (trace 1 |.("leaving subscription to {<app>}"))
:* %g %deal [our ship] app
:* %g %deal [our ship /eyre] app
`task:agent:gall`[%leave ~]
==
::
@ -1665,7 +1666,7 @@
^- move
:^ duct %pass
(subscription-wire channel-id request-id ship app)
[%g %deal [our ship] app `task:agent:gall`[%leave ~]]
[%g %deal [our ship /eyre] app `task:agent:gall`[%leave ~]]
:: +emit-event: records an event occurred, possibly sending to client
::
:: When an event occurs, we need to record it, even if we immediately
@ -1768,7 +1769,7 @@
%- (trace 1 |.("leaving subscription to {<app>}"))
:^ duct %pass
(subscription-wire channel-id request-id ship app)
[%g %deal [our ship] app %leave ~]
[%g %deal [our ship /eyre] app %leave ~]
:: update channel state to reflect the %kick
::
=? u.channel kicking
@ -1821,7 +1822,7 @@
?~ sub
((trace 0 |.("no subscription for request-id {(scow %ud request-id)}")) ~)
=/ des=(unit (unit cage))
(rof ~ %gd [our app.u.sub da+now] /$)
(rof ~ /eyre %gd [our app.u.sub da+now] /$)
?. ?=([~ ~ *] des)
((trace 0 |.("no desk for app {<app.u.sub>}")) ~)
`!<(=desk q.u.u.des)
@ -1857,7 +1858,7 @@
=* have=mark mark.event
=/ convert=(unit vase)
=/ cag=(unit (unit cage))
(rof ~ %cf [our desk.event da+now] /[have]/json)
(rof ~ /eyre %cf [our desk.event da+now] /[have]/json)
?. ?=([~ ~ *] cag) ~
`q.u.u.cag
?~ convert
@ -1979,7 +1980,7 @@
%- (trace 1 |.("{<channel-id>} leaving subscription to {<app>}"))
:^ duc %pass
(subscription-wire channel-id request-id ship app)
[%g %deal [our ship] app %leave ~]
[%g %deal [our ship /eyre] app %leave ~]
--
:: +handle-gall-error: a call to +poke-http-response resulted in a %coup
::
@ -1997,7 +1998,7 @@
:_ ~
%- (trace 1 |.("leaving subscription to {<app.action.connection>}"))
:* duct %pass /watch-response/[eyre-id]
%g %deal [our our] app.action.connection
%g %deal [our our /eyre] app.action.connection
%leave ~
==
::
@ -2140,7 +2141,7 @@
%- %+ trace 1
|.("leaving subscription to {<app.action.u.connection-state>}")
:* duct %pass /watch-response/[eyre-id]
%g %deal [our our] app.action.u.connection-state
%g %deal [our our /eyre] app.action.u.connection-state
%leave ~
==
--
@ -2538,7 +2539,7 @@
:_ http-server-gate
=/ cmd
[%acme %poke `cage`[%acme-order !>(mod)]]
[duct %pass /acme/order %g %deal [our our] cmd]~
[duct %pass /acme/order %g %deal [our our /eyre] cmd]~
==
::
%request
@ -2924,7 +2925,7 @@
++ scry
~/ %eyre-scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem

View File

@ -44,7 +44,7 @@
+$ move [=duct move=(wind note-arvo gift-arvo)]
:: $state-13: overall gall state, versioned
::
+$ state-13 [%13 state]
+$ state-14 [%14 state]
:: $state: overall gall state
::
:: system-duct: TODO document
@ -66,7 +66,7 @@
::
+$ routes
$: disclosing=(unit (set ship))
attributing=ship
attributing=[=ship =path]
==
:: $yoke: agent runner state
::
@ -162,7 +162,7 @@
:: $spore: structures for update, produced by +stay
::
+$ spore
$: %13
$: %14
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
@ -192,7 +192,7 @@
--
:: adult gall vane interface, for type compatibility with pupa
::
=| state=state-13
=| state=state-14
|= [now=@da eny=@uvJ rof=roof]
=* gall-payload .
~% %gall-top ..part ~
@ -249,7 +249,7 @@
:: +mo-doff: kill all outgoing subscriptions
::
++ mo-doff
|= [dude=(unit dude) ship=(unit ship)]
|= [prov=path dude=(unit dude) ship=(unit ship)]
^+ mo-core
=/ apps=(list (pair term yoke))
?~ dude ~(tap by yokes.state)
@ -257,12 +257,12 @@
|- ^+ mo-core
?~ apps mo-core
?: ?=(%nuke -.q.i.apps) $(apps t.apps)
=/ ap-core (ap-yoke:ap p.i.apps [~ our] q.i.apps)
=/ ap-core (ap-yoke:ap p.i.apps [~ our prov] q.i.apps)
$(apps t.apps, mo-core ap-abet:(ap-doff:ap-core ship))
:: +mo-rake: send %cork's for old subscriptions if needed
::
++ mo-rake
|= [dude=(unit dude) all=?]
|= [prov=path dude=(unit dude) all=?]
^+ mo-core
=/ apps=(list (pair term yoke))
?~ dude ~(tap by yokes.state)
@ -270,7 +270,7 @@
|- ^+ mo-core
?~ apps mo-core
?: ?=(%nuke -.q.i.apps) $(apps t.apps)
=/ ap-core (ap-yoke:ap p.i.apps [~ our] q.i.apps)
=/ ap-core (ap-yoke:ap p.i.apps [~ our prov] q.i.apps)
$(apps t.apps, mo-core ap-abet:(ap-rake:ap-core all))
:: +mo-receive-core: receives an app core built by %ford.
::
@ -286,7 +286,7 @@
::
++ mo-receive-core
~/ %mo-receive-core
|= [dap=term bek=beak =agent]
|= [prov=path dap=term bek=beak =agent]
^+ mo-core
::
=/ yak (~(get by yokes.state) dap)
@ -309,7 +309,7 @@
::
=. yokes.state
(~(put by yokes.state) dap u.yak(beak bek, code agent))
=/ ap-core (ap-abed:ap dap `our)
=/ ap-core (ap-abed:ap dap [~ our prov])
=. ap-core (ap-reinstall:ap-core agent)
=. mo-core ap-abet:ap-core
(mo-clear-queue dap)
@ -329,7 +329,7 @@
::
=/ old mo-core
=/ wag
=/ ap-core (ap-abed:ap dap `our)
=/ ap-core (ap-abed:ap dap [~ our prov])
(ap-upgrade-state:ap-core ~)
::
=/ maybe-tang -.wag
@ -419,7 +419,7 @@
:: +mo-breach: ship breached, so forget about them
::
++ mo-breach
|= =ship
|= [prov=path =ship]
^+ mo-core
=. mo-core (mo-untrack-ship ship)
=. mo-core (mo-filter-queue ship)
@ -434,7 +434,7 @@
?~ agents
mo-core
=? mo-core ?=(%live -.yoke.i.agents)
=/ =routes [disclosing=~ attributing=ship]
=/ =routes [disclosing=~ attributing=[ship prov]]
=/ app (ap-abed:ap name.i.agents routes)
ap-abet:(ap-breach:app ship)
$(agents t.agents)
@ -464,7 +464,7 @@
?> ?=([%era ~] wire)
?. ?=(%breach -.public-keys-result.sign-arvo)
mo-core
(mo-breach who.public-keys-result.sign-arvo)
(mo-breach /jael who.public-keys-result.sign-arvo)
:: +mo-handle-sys-lag: handle an ames %clog notification
::
++ mo-handle-sys-lag
@ -479,7 +479,7 @@
?~ agents mo-core
::
=? mo-core ?=(%live -.yoke.i.agents)
=/ app (ap-abed:ap dude.i.agents `our)
=/ app (ap-abed:ap dude.i.agents [~ our /ames])
ap-abet:(ap-clog:app ship.sign-arvo)
::
$(agents t.agents)
@ -630,14 +630,16 @@
mo-core
=/ app
=/ =ship (slav %p i.t.t.wire)
=/ =routes [disclosing=~ attributing=ship]
=/ =routes [disclosing=~ attributing=[ship /[-.sign-arvo]]]
(ap-abed:ap dap routes)
::
=. app (ap-generic-take:app t.t.t.wire sign-arvo)
ap-abet:app
?> ?=([%out @ @ *] t.t.wire)
=/ =ship (slav %p i.t.t.t.wire)
=/ =routes [disclosing=~ attributing=ship]
=/ other-agent i.t.t.t.t.wire
=/ prov=path ?.(=(ship our) *path /gall/[other-agent])
=/ =routes [disclosing=~ attributing=[ship prov]]
=/ =unto +>.sign-arvo
?: ?=(%| -.agent.u.yoke)
=/ blocked=(qeu blocked-move)
@ -672,7 +674,7 @@
~(get to blocked)
?: ?=(%| -.blocker) $
=/ =move
=/ =sock [attributing.routes our]
=/ =sock [ship.attributing.routes our path.attributing.routes]
=/ card [%slip %g %deal sock dap p.blocker]
[duct card]
$(moves [move moves])
@ -696,30 +698,30 @@
new-agents (~(put by new-agents) name.i.agents new-blocked)
==
=^ mov=blocked-move blocked.i.agents ~(get to blocked.i.agents)
=? new-blocked !=(ship attributing.routes.mov)
=? new-blocked !=(ship ship.attributing.routes.mov)
(~(put to new-blocked) mov)
$
:: +mo-idle: put agent to sleep
::
++ mo-idle
|= dap=dude
|= [prov=path dap=dude]
^+ mo-core
=/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %idle for {<dap>}, not running"
mo-core
ap-abet:ap-idle:(ap-abed:ap dap `our)
ap-abet:ap-idle:(ap-abed:ap dap [~ our prov])
:: +mo-nuke: delete agent completely
::
++ mo-nuke
|= dap=dude
|= [prov=path dap=dude]
^+ mo-core
=/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %nuke for {<dap>}, not running"
mo-core
~> %slog.0^leaf/"gall: nuking {<dap>}"
=. mo-core ap-abet:ap-nuke:(ap-abed:ap dap `our)
=. mo-core ap-abet:ap-nuke:(ap-abed:ap dap [~ our prov])
=- mo-core(yokes.state -)
%+ ~(jab by yokes.state) dap
|= =^yoke
@ -731,13 +733,13 @@
:: +mo-load: install agents
::
++ mo-load
|= agents=(list [=dude =beak =agent])
|= [prov=path agents=(list [=dude =beak =agent])]
=. mo-core
|- ^+ mo-core
?~ agents mo-core
=/ [=dude =desk] [dude q.beak]:i.agents
:: ~> %slog.0^leaf/"gall: starting {<dude>} on {<desk>}"
$(agents t.agents, mo-core (mo-receive-core i.agents))
$(agents t.agents, mo-core (mo-receive-core prov i.agents))
::
=/ kil
=/ lol
@ -749,7 +751,7 @@
|- ^+ mo-core
?~ kil mo-core
~> %slog.0^leaf/"gall: stopping {<i.kil>}"
$(kil t.kil, mo-core (mo-idle i.kil))
$(kil t.kil, mo-core (mo-idle prov i.kil))
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
::
++ mo-peek
@ -776,7 +778,7 @@
=/ =case da+now
=/ yok (~(got by yokes.state) dap)
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
=/ sky (rof ~ %cb [our desk case] /[mark.deal])
=/ sky (rof ~ /gall %cb [our desk case] /[mark.deal])
?- sky
?(~ [~ ~])
=/ ror "gall: raw-poke fail :{(trip dap)} {<mark.deal>}"
@ -800,7 +802,7 @@
=/ mars-path /[a.mars]/[b.mars]
=/ yok (~(got by yokes.state) dap)
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
=/ sky (rof ~ %cc [our desk case] mars-path)
=/ sky (rof ~ /gall %cc [our desk case] mars-path)
?- sky
?(~ [~ ~])
=/ ror "gall: poke cast fail :{(trip dap)} {<mars>}"
@ -831,10 +833,10 @@
:: +deal. Otherwise simply apply the action to the agent.
::
++ mo-handle-local
|= [=ship agent=term =deal]
|= [prov=path =ship agent=term =deal]
^+ mo-core
::
=/ =routes [disclosing=~ attributing=ship]
=/ =routes [disclosing=~ attributing=[ship prov]]
=/ running (~(get by yokes.state) agent)
=/ is-running &(?=([~ %live *] running) ?=(%& -.agent.u.running))
=/ is-blocked (~(has by blocked.state) agent)
@ -872,7 +874,7 @@
%s [%watch path.ames-request]
%u [%leave ~]
==
(mo-pass wire %g %deal [ship our] agent-name deal)
(mo-pass wire %g %deal [ship our /] agent-name deal)
:: +mo-spew: handle request to set verbosity toggles on debug output
::
++ mo-spew
@ -1111,7 +1113,7 @@
=/ =case da+now
=/ bek=beak [our q.beak.yoke case]
=/ mars-path /[a.mars]/[b.mars]
=/ sky (rof ~ %cc bek mars-path)
=/ sky (rof ~ /gall %cc bek mars-path)
?- sky
?(~ [~ ~])
%- (slog leaf+"watch-as fact conversion find-fail" >sky< ~)
@ -1145,14 +1147,15 @@
?- -.neet
%agent [%out (scot %p ship.neet) name.neet wire]
%huck [%out (scot %p ship.neet) name.neet wire]
%arvo [(scot %p attributing.agent-routes) wire]
%arvo [(scot %p ship.attributing.agent-routes) wire]
==
::
=/ =note-arvo
=/ prov=path /gall/[agent-name]
?- -.neet
%arvo +.neet
%huck note-arvo.neet
%agent [%g %deal [our ship.neet] [name task]:neet]
%agent [%g %deal [our ship.neet prov] [name task]:neet]
==
[duct %pass wire note-arvo]~
==
@ -1284,7 +1287,7 @@
=/ tub=(unit tube:clay)
?: =(have want) `(bake same ^vase)
=/ tuc=(unit (unit cage))
(rof ~ %cc [our q.beak.yoke da+now] /[have]/[want])
(rof ~ /gall %cc [our q.beak.yoke da+now] /[have]/[want])
?. ?=([~ ~ *] tuc) ~
`!<(tube:clay q.u.u.tuc)
?~ tub
@ -1313,8 +1316,9 @@
++ ap-construct-bowl
^- bowl
:* :* our :: host
attributing.agent-routes :: guest
ship.attributing.agent-routes :: guest
agent-name :: agent
path.attributing.agent-routes :: provenance
== ::
:* wex=boat.yoke :: outgoing
sup=bitt.yoke :: incoming
@ -1359,7 +1363,7 @@
~/ %ap-subscribe
|= pax=path
^+ ap-core
=/ incoming [attributing.agent-routes pax]
=/ incoming [ship.attributing.agent-routes pax]
=. bitt.yoke (~(put by bitt.yoke) agent-duct incoming)
=^ maybe-tang ap-core
%+ ap-ingest %watch-ack |.
@ -1421,7 +1425,7 @@
?: ?=(%spider agent-name)
:- [%fact mark.unto !>(noun.unto)]
ap-core
=/ sky (rof ~ %cb [our q.beak.yoke case] /[mark.unto])
=/ sky (rof ~ /gall %cb [our q.beak.yoke case] /[mark.unto])
?. ?=([~ ~ *] sky)
(mean leaf+"gall: ames mark fail {<mark.unto>}" ~)
::
@ -1603,7 +1607,8 @@
|= =duct
^- (list move)
::
:~ [duct %slip %g %deal [our our] agent-name %leave ~]
=/ =sock [our our /gall/[agent-name]]
:~ [duct %slip %g %deal sock agent-name %leave ~]
[duct %give %unto %kick ~]
==
:: +ap-kill-down: 2-sided kill from subscriber side
@ -1675,7 +1680,7 @@
++ scry-peer-state
|= her=ship
~+ ^- (unit peer-state:ames)
=/ sky (rof [~ ~] %ax [our %$ da+now] /peers/(scot %p her))
=/ sky (rof [~ ~] /gall %ax [our %$ da+now] /peers/(scot %p her))
?: |(?=(~ sky) ?=(~ u.sky))
~
=/ sat !<(ship-state:ames q.u.u.sky)
@ -1692,7 +1697,7 @@
++ ap-mule
|= run=_^?(|.(*step:agent))
^- (each step:agent tang)
=/ res (mock [run %9 2 %0 1] (look rof ~))
=/ res (mock [run %9 2 %0 1] (look rof ~ /gall/[agent-name]))
?- -.res
%0 [%& !<(step:agent [-:!>(*step:agent) p.res])]
%1 [%| (smyt ;;(path p.res)) ~]
@ -1703,7 +1708,7 @@
++ ap-mule-peek
|= run=_^?(|.(*(unit (unit cage))))
^- (each (unit (unit cage)) tang)
=/ res (mock [run %9 2 %0 1] (look rof ~))
=/ res (mock [run %9 2 %0 1] (look rof ~ /gall/[agent-name]))
?- -.res
%0 [%& !<((unit (unit cage)) [-:!>(*(unit (unit cage))) p.res])]
%1 [%| (smyt ;;(path p.res)) ~]
@ -1874,6 +1879,18 @@
::
~| [%gall-call-failed duct hic]
=/ =task ((harden task) hic)
=/ prov=path
?: ?=(%deal -.task)
?.(=(p.p.task our) *path r.p.task)
?. ?& ?=([^ *] duct)
?= $? %ames %behn %clay
%dill %eyre %gall
%iris %jael %khan
==
i.i.duct
==
*path
/[i.i.duct]
::
=/ mo-core (mo-abed:mo duct)
?- -.task
@ -1882,7 +1899,7 @@
?. =(q.sock our)
?> =(p.sock our)
mo-abet:(mo-send-foreign-request:mo-core q.sock term deal)
mo-abet:(mo-handle-local:mo-core p.sock term deal)
mo-abet:(mo-handle-local:mo-core prov p.sock term deal)
::
%init [~ gall-payload(system-duct.state duct)]
%plea
@ -1901,11 +1918,11 @@
::
%sear mo-abet:(mo-filter-queue:mo-core ship.task)
%jolt mo-abet:(mo-jolt:mo-core dude.task our desk.task)
%idle mo-abet:(mo-idle:mo-core dude.task)
%load mo-abet:(mo-load:mo-core +.task)
%nuke mo-abet:(mo-nuke:mo-core dude.task)
%doff mo-abet:(mo-doff:mo-core +.task)
%rake mo-abet:(mo-rake:mo-core +.task)
%idle mo-abet:(mo-idle:mo-core prov dude.task)
%load mo-abet:(mo-load:mo-core prov +.task)
%nuke mo-abet:(mo-nuke:mo-core prov dude.task)
%doff mo-abet:(mo-doff:mo-core prov +.task)
%rake mo-abet:(mo-rake:mo-core prov +.task)
%spew mo-abet:(mo-spew:mo-core veb.task)
%sift mo-abet:(mo-sift:mo-core dudes.task)
%trim [~ gall-payload]
@ -1921,17 +1938,33 @@
=? old ?=(%10 -.old) (spore-10-to-11 old)
=? old ?=(%11 -.old) (spore-11-to-12 old)
=? old ?=(%12 -.old) (spore-12-to-13 old)
?> ?=(%13 -.old)
=? old ?=(%13 -.old) (spore-13-to-14 old)
?> ?=(%14 -.old)
gall-payload(state old)
::
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11 spore-12)
+$ spore-any
$%(spore spore-7 spore-8 spore-9 spore-10 spore-11 spore-12 spore-13)
+$ spore-13
$: %13
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg)
blocked=(map term (qeu blocked-move-13))
=bug
==
+$ blocked-move-13 [=duct routes=routes-13 move=(each deal unto)]
+$ routes-13
$: disclosing=(unit (set ship))
attributing=ship
==
+$ spore-12
$: %12
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg-12)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
=bug
==
+$ egg-12
@ -1956,7 +1989,7 @@
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg-11)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
=bug
==
+$ egg-11
@ -1978,7 +2011,7 @@
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg-10)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
=bug
==
+$ egg-10
@ -2000,7 +2033,7 @@
outstanding=(map [wire duct] (qeu remote-request-9))
contacts=(set ship)
eggs=(map term egg-10)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
=bug
==
::
@ -2012,7 +2045,7 @@
outstanding=(map [wire duct] (qeu remote-request-9))
contacts=(set ship)
eggs=(map term egg-8)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
==
+$ egg-8
$: control-duct=duct
@ -2033,7 +2066,7 @@
outstanding=(map [wire duct] (qeu remote-request-9))
contacts=(set ship)
eggs=(map term egg-8)
blocked=(map term (qeu blocked-move))
blocked=(map term (qeu blocked-move-13))
==
::
++ spore-7-to-8
@ -2115,7 +2148,7 @@
::
++ spore-12-to-13
|= old=spore-12
^- spore
^- spore-13
%= old
- %13
eggs
@ -2125,13 +2158,32 @@
?: ?=(%nuke -.e) e
e(sky [sky.e ken:*$>(%live egg)])
==
:: added provenance path to routes
::
++ spore-13-to-14
|= old=spore-13
^- spore
%= old
- %14
blocked
^- (map term (qeu blocked-move))
%- ~(run by blocked.old)
|= q=(qeu blocked-move-13)
%- ~(gas to *(qeu blocked-move))
%+ turn ~(tap to q)
|= blocked=blocked-move-13
^- blocked-move
%= blocked
attributing.routes [ship=attributing.routes.blocked path=/]
==
==
--
:: +scry: standard scry
::
++ scry
~/ %gall-scry
^- roon
|= [lyc=gang care=term bem=beam]
|= [lyc=gang pov=path care=term bem=beam]
^- (unit (unit cage))
=* ship p.bem
=* dap q.bem
@ -2149,7 +2201,7 @@
== ~
?. (~(has by yokes.state) dap) [~ ~]
?. ?=(^ path) ~
=/ =routes [~ ship]
=/ =routes [~ ship pov]
(mo-peek:mo & dap routes care path)
::
=> .(path t.path)
@ -2240,7 +2292,7 @@
|= [dap=term =yoke]
^- mass
=/ met=(list mass)
=/ dat (mo-peek:mo | dap [~ ship] %x /whey/mass)
=/ dat (mo-peek:mo | dap [~ ship pov] %x /whey/mass)
?: ?=(?(~ [~ ~]) dat) ~
(fall ((soft (list mass)) q.q.u.u.dat) ~)
?~ met

View File

@ -385,7 +385,7 @@
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem

View File

@ -199,7 +199,7 @@
/[app]/poke
%g
%deal
[our our]
[our our /jael]
app
%poke
%azimuth-poke
@ -635,7 +635,7 @@
[app path]
%g
%deal
[our our]
[our our /jael]
app
%watch
path
@ -1055,7 +1055,7 @@
:: :: ++scry
++ scry :: inspect
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem

View File

@ -72,7 +72,7 @@
++ get-dais
|= [=beak =mark rof=roof]
^- dais:clay
?~ ret=(rof ~ %cb beak /[mark])
?~ ret=(rof ~ /khan %cb beak /[mark])
~|(mark-unknown+mark !!)
?~ u.ret
~|(mark-invalid+mark !!)
@ -82,7 +82,7 @@
++ get-tube
|= [=beak =mark =out=mark rof=roof]
^- tube:clay
?~ ret=(rof ~ %cc beak /[mark]/[out-mark])
?~ ret=(rof ~ /khan %cc beak /[mark]/[out-mark])
~|(tube-unknown+[mark out-mark] !!)
?~ u.ret
~|(tube-invalid+[mark out-mark] !!)
@ -105,12 +105,12 @@
++ poke-spider
|= [hen=duct =cage]
^- move
[hen %pass //g %g %deal [our our] %spider %poke cage]
[hen %pass //g %g %deal [our our /khan] %spider %poke cage]
::
++ watch-spider
|= [hen=duct =path]
^- move
[hen %pass //g %g %deal [our our] %spider %watch path]
[hen %pass //g %g %deal [our our /khan] %spider %watch path]
--
=| khan-state
=* state -
@ -173,7 +173,7 @@
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
~
++ stay state

View File

@ -4,7 +4,7 @@
=> ..lull
~% %zuse ..part ~
|%
++ zuse %413
++ zuse %412
:: :: ::
:::: :: :: (2) engines
:: :: ::
@ -5265,10 +5265,10 @@
::
=> |%
++ sein
|= [rof=roof our=ship now=@da who=ship]
|= [rof=roof pov=path our=ship now=@da who=ship]
;; ship
=< q.q %- need %- need
(rof ~ %j `beam`[[our %sein %da now] /(scot %p who)])
(rof ~ pov %j `beam`[[our %sein %da now] /(scot %p who)])
--
:: middle core: stateless queries for default numeric sponsorship
::