Merge branch 'develop' into i/6103/abet-pure

This commit is contained in:
jose 2023-05-22 13:23:02 +02:00 committed by GitHub
commit 7df931b375
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 136 additions and 72 deletions

View File

@ -300,7 +300,7 @@
~/ %handle-http-request ~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre] |= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state) ^- (quip card _state)
::?> authenticated.inbound-request ?> authenticated.inbound-request
=/ url =/ url
(parse-request-line:server url.request.inbound-request) (parse-request-line:server url.request.inbound-request)
?> ?=([%spider @t @t @t @t ~] site.url) ?> ?=([%spider @t @t @t @t ~] site.url)

View File

@ -0,0 +1,11 @@
:: Print keys for a ship, as stored in %ames
::
:- %say
|= [[now=time @ our=ship ^] [=ship ~] ~]
=+ .^ =ship-state:ames
%ax /(scot %p our)//(scot %da now)/peers/(scot %p ship)
==
:- %noun
?. ?=(%known -.ship-state)
%ship-still-alien
[life=life rift=rift]:+.ship-state

View File

@ -10,14 +10,11 @@
=/ our p.bec =/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide =? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk) ?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist." helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
helm-pass+[%d %noop ~]
=/ existing-story .^(? %cu /(scot %p our)/[desk]/(scot %da now)/story) =/ existing-story .^(? %cu /(scot %p our)/[desk]/(scot %da now)/story)
?: ?&(existing-story !overwrite) ?: ?&(existing-story !overwrite)
~& >> "Error: /{(trip (slav %tas desk))}/story already exists." :- %helm-pass
~& >> "To forcibly overwrite, use `=overwrite %.y`" [%d %flog %text "Error: /{(trip (slav %tas desk))}/story already exists. To forcibly overwrite, use `=overwrite %.y`"]
:: XX could use a better way to noop
helm-pass+[%d %noop ~]
=| tale=story =| tale=story
:- %helm-pass :- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]] [%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -13,8 +13,7 @@
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide =? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided =? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk) ?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist." helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
helm-pass+[%d %noop ~]
=/ tak=tako:clay =/ tak=tako:clay
?: ?=([%tako tako:clay] cas) ?: ?=([%tako tako:clay] cas)
p.cas p.cas
@ -25,12 +24,11 @@
:: ::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story =/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax) ?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one." helm-pass+[%d %flog %text "Error: No story file found. Please use |story-init to create one."]
helm-pass+[%d %noop ~]
=/ tale=story .^(story %cx pax) =/ tale=story .^(story %cx pax)
=. tale =. tale
?: =(*prose prz) ?: =(*prose prz)
(~(del by tale) tak) (~(del by tale) tak)
(~(del ju tale) tak prz) (~(del ju tale) tak prz)
:- %helm-pass :- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]] [%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -13,8 +13,7 @@
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide =? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided =? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk) ?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist." helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
helm-pass+[%d %noop ~]
=/ tak=tako:clay =/ tak=tako:clay
?: ?=([%tako tako:clay] cas) ?: ?=([%tako tako:clay] cas)
p.cas p.cas
@ -25,10 +24,9 @@
:: ::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story =/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax) ?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one." helm-pass+[%d %flog %text "Error: No story file found. Please use |story-init to create one."]
helm-pass+[%d %noop ~]
=/ tale=story .^(story %cx /(scot %p our)/[desk]/(scot %da now)/story) =/ tale=story .^(story %cx /(scot %p our)/[desk]/(scot %da now)/story)
=/ =prose [title ?~(body '' p.body)] =/ =prose [title ?~(body '' p.body)]
=. tale (~(put ju tale) tak prose) =. tale (~(put ju tale) tak prose)
:- %helm-pass :- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]] [%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -2,6 +2,6 @@
:- %say :- %say
|= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&] |= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&]
:* %tang :* %tang
leaf+"Notice: +vat is deprecated as +vats now takes lists of one or more desks" leaf+"Notice: +vat is deprecated. use +vats which now takes one or more desks as arguments. e.g. '+vats %base %garden'"
(report-vat (report-prep p.bec now) p.bec now syd verb) (report-vat (report-prep p.bec now) p.bec now syd verb)
== ==

View File

@ -1741,41 +1741,56 @@
++ on-stir ++ on-stir
|= arg=@t |= arg=@t
^+ event-core ^+ event-core
=/ want=(set [@da ^duct]) |^ ?+ arg do-stir
%- ~(rep by peers.ames-state) %rift do-rift
|= [[who=ship s=ship-state] acc=(set [@da ^duct])] ==
?. ?=(%known -.s) acc
%- ~(rep by snd.+.s)
|= [[b=bone m=message-pump-state] acc=_acc]
=* tim next-wake.packet-pump-state.m
?~ tim acc
%- ~(put in acc)
[u.tim `^duct`~[ames+(make-pump-timer-wire who b) /ames]]
=. want
(~(put in want) (add now ~d1) ~[/ames/recork /ames])
:: ::
=/ have ++ do-rift
%- ~(gas in *(set [@da ^duct])) =/ =rift
=/ tim =- ~|(%no-rift (,@ q.q:(need (need -))))
;; (list [@da ^duct]) (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])
=< q.q %- need %- need ?: =(rift rift.ames-state)
(rof ~ %bx [[our %$ da+now] /debug/timers]) event-core
(skim tim |=([@da hen=^duct] ?=([[%ames ?(%pump %recork) *] *] hen))) ~& "ames: fixing rift from {<rift.ames-state>} to {<rift>}"
event-core(ames-state ames-state(rift rift))
:: ::
:: set timers for flows that should have one set but don't ++ do-stir
:: =/ want=(set [@da ^duct])
=. event-core %- ~(rep by peers.ames-state)
%- ~(rep in (~(dif in want) have)) |= [[who=ship s=ship-state] acc=(set [@da ^duct])]
?. ?=(%known -.s) acc
%- ~(rep by snd.+.s)
|= [[b=bone m=message-pump-state] acc=_acc]
=* tim next-wake.packet-pump-state.m
?~ tim acc
%- ~(put in acc)
[u.tim `^duct`~[ames+(make-pump-timer-wire who b) /ames]]
=. want
(~(put in want) (add now ~d1) ~[/ames/recork /ames])
::
=/ have
%- ~(gas in *(set [@da ^duct]))
=/ tim
;; (list [@da ^duct])
=< q.q %- need %- need
(rof ~ %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
::
=. event-core
%- ~(rep in (~(dif in want) have))
|= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen)
(emit:this ~[/ames] %pass t.i.hen %b %wait wen)
::
:: cancel timers for flows that have one set but shouldn't
::
%- ~(rep in (~(dif in have) want))
|= [[wen=@da hen=^duct] this=_event-core] |= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen) ?> ?=([^ *] hen)
(emit:this ~[/ames] %pass t.i.hen %b %wait wen) (emit:this t.hen %pass t.i.hen %b %rest wen)
:: --
:: cancel timers for flows that have one set but shouldn't
::
%- ~(rep in (~(dif in have) want))
|= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen)
(emit:this t.hen %pass t.i.hen %b %rest wen)
:: +on-crud: handle event failure; print to dill :: +on-crud: handle event failure; print to dill
:: ::
++ on-crud ++ on-crud
@ -2206,7 +2221,11 @@
=/ peer-core (abed-peer:pe her.u.res u.state) =/ peer-core (abed-peer:pe her.u.res u.state)
?- -.u.res ?- -.u.res
%pump abet:(on-wake:peer-core bone.u.res error) %pump abet:(on-wake:peer-core bone.u.res error)
%fine abet:fi-abet:fi-take-wake:(abed:fi:peer-core wire.u.res) ::
%fine
?. (~(has by keens.peer-state.peer-core) wire.u.res)
event-core
abet:fi-abet:fi-take-wake:(abed:fi:peer-core wire.u.res)
== ==
:: ::
=. event-core (emit duct %pass /recork %b %wait `@da`(add now ~d1)) =. event-core (emit duct %pass /recork %b %wait `@da`(add now ~d1))
@ -2903,6 +2922,10 @@
:: expire direct route if the peer is not responding :: expire direct route if the peer is not responding
:: ::
=. peer-state (update-peer-route her peer-state) =. peer-state (update-peer-route her peer-state)
:: required so that the following +send-blob's (including
:: inside +call:mu), access up-to-date peer state
::
=. event-core abet
:: resend comet attestation packet if first message times out :: resend comet attestation packet if first message times out
:: ::
:: The attestation packet doesn't get acked, so if we tried to :: The attestation packet doesn't get acked, so if we tried to
@ -4478,7 +4501,7 @@
:: if this was a re-send, don't adjust rtt or downstream state :: if this was a re-send, don't adjust rtt or downstream state
:: ::
?: (gth tries.packet-state 1) ?: (gth tries.packet-state 1)
metrics metrics(rto (clamp-rto (add rtt (mul 4 rttvar))))
:: rtt-datum: new rtt measurement based on packet roundtrip :: rtt-datum: new rtt measurement based on packet roundtrip
:: ::
=/ rtt-datum=@dr (sub-safe now last-sent.packet-state) =/ rtt-datum=@dr (sub-safe now last-sent.packet-state)

View File

@ -714,7 +714,14 @@
=. stack.nub [~ stack.nub] =. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) cast+[a b]) ?: (~(has in cycle.nub) cast+[a b])
~|(cycle+cast+[a b]^cycle.nub !!) ~|(cycle+cast+[a b]^cycle.nub !!)
?: =(a b)
%+ gain-leak cast+a^b
|= nob=state
%- (trace 4 |.("identity shortcircuit"))
=. nub nob
:_(nub vase+same.bud)
?: =([%mime %hoon] [a b]) ?: =([%mime %hoon] [a b])
%- (trace 4 |.("%mime -> %hoon shortcircuit"))
:_(nub [%vase =>(..zuse !>(|=(m=mime q.q.m)))]) :_(nub [%vase =>(..zuse !>(|=(m=mime q.q.m)))])
:: try +grow; is there a +grow core with a .b arm? :: try +grow; is there a +grow core with a .b arm?
:: ::
@ -729,6 +736,7 @@
:: ::
%+ gain-leak cast+a^b %+ gain-leak cast+a^b
|= nob=state |= nob=state
%- (trace 4 |.("{<a>} -> {<b>}: +{(trip b)}:grow:{(trip a)}"))
=. nub nob =. nub nob
:_ nub :- %vase :_ nub :- %vase
%+ slap (with-faces cor+old ~) %+ slap (with-faces cor+old ~)
@ -743,18 +751,24 @@
?: &(?=(%& -.rab) ?=(^ q.p.rab)) ?: &(?=(%& -.rab) ?=(^ q.p.rab))
%+ gain-leak cast+a^b %+ gain-leak cast+a^b
|= nob=state |= nob=state
%- (trace 4 |.("{<a>} -> {<b>}: +{(trip a)}:grab:{(trip b)}"))
=. nub nob =. nub nob
:_(nub vase+p.rab) :_(nub vase+p.rab)
:: try +jump :: try +jump
:: ::
=/ jum (mule |.((slap old tsgl/[limb/b limb/%jump]))) =/ jum (mule |.((slap old tsgl/[limb/b limb/%jump])))
?: ?=(%& -.jum) ?: ?=(%& -.jum)
(compose-casts a !<(mark p.jum) b) =/ via !<(mark p.jum)
%- (trace 4 |.("{<a>} -> {<b>}: via {<via>} per +jump:{(trip a)}"))
(compose-casts a via b)
?: ?=(%& -.rab) ?: ?=(%& -.rab)
(compose-casts a !<(mark p.rab) b) =/ via !<(mark p.rab)
%- (trace 4 |.("{<a>} -> {<b>}: via {<via>} per +grab:{(trip b)}"))
(compose-casts a via b)
?: ?=(%noun b) ?: ?=(%noun b)
%+ gain-leak cast+a^b %+ gain-leak cast+a^b
|= nob=state |= nob=state
%- (trace 4 |.("{<a>} -> {<b>} default"))
=. nub nob =. nub nob
:_(nub vase+same.bud) :_(nub vase+same.bud)
~|(no-cast-from+[a b] !!) ~|(no-cast-from+[a b] !!)
@ -1818,7 +1832,11 @@
=? ..park !?=(%base syd) wick :: [wick] =? ..park !?=(%base syd) wick :: [wick]
%- (slog leaf+"clay: wait-for-kelvin, {<[need=zuse/zuse have=kel]>}" ~) %- (slog leaf+"clay: wait-for-kelvin, {<[need=zuse/zuse have=kel]>}" ~)
tare :: [tare] > tare :: [tare] >
=. wic.dom (~(del by wic.dom) zuse+zuse) =. wic.dom
%- ~(gas by *(map weft ^yoki))
%+ skip ~(tap by wic.dom)
|= [w=weft ^yoki]
(gte num.w zuse)
:: ::
=/ old-yaki =/ old-yaki
?: =(0 let.dom) ?: =(0 let.dom)
@ -3304,7 +3322,6 @@
|= [inx=@ud rut=(unit rand)] |= [inx=@ud rut=(unit rand)]
^+ +> ^+ +>
?> ?=(^ ref) ?> ?=(^ ref)
~& take-foreign/inx
=+ ruv=(~(get by bom.u.ref) inx) =+ ruv=(~(get by bom.u.ref) inx)
?~ ruv ?~ ruv
~& %bad-answer ~& %bad-answer
@ -4489,13 +4506,14 @@
++ read-at-tako :: read-at-tako:ze ++ read-at-tako :: read-at-tako:ze
|= [for=(unit ship) tak=tako mun=mood] :: seek and read |= [for=(unit ship) tak=tako mun=mood] :: seek and read
^- [(unit (unit cage)) _..park] ^- [(unit (unit cage)) _..park]
?. |(?=(~ for) (may-read u.for care.mun tak path.mun)) :: non-zero commits must be known, and reachable from within this desk
[~ ..park]
:: the commit must be known, and reachable from within this desk
:: ::
?. ?| =(0v0 tak) ?. ?| =(0v0 tak)
?& (~(has by hut.ran) tak) ?& (~(has by hut.ran) tak)
(~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak) ?| (~(any by hit.dom) |=(=tako =(tak tako))) :: fast-path
(~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak)
==
|(?=(~ for) (may-read u.for care.mun tak path.mun))
== == == ==
[~ ..park] [~ ..park]
:: virtualize to catch and produce deterministic failures :: virtualize to catch and produce deterministic failures

View File

@ -2358,12 +2358,24 @@
:: ::
=/ task=task ((harden task) wrapped-task) =/ task=task ((harden task) wrapped-task)
:: ::
:: XX handle error notifications :: XX handle more error notifications
:: ::
?^ dud ?^ dud
=/ moves=(list move) :_ http-server-gate
[[duct %slip %d %flog %crud [-.task tang.u.dud]] ~] :: always print the error trace
[moves http-server-gate] ::
:- [duct %slip %d %flog %crud [-.task tang.u.dud]]
^- (list move)
:: if a request caused the crash, respond with a 500
::
?. ?=(?(%request %request-local) -.task) ~
^~
=/ data (as-octs:mimes:html 'crud!')
=/ head
:~ ['content-type' 'text/html']
['content-length' (crip (a-co:co p.data))]
==
[duct %give %response %start 500^head `data &]~
:: %init: tells us what our ship name is :: %init: tells us what our ship name is
:: ::
?: ?=(%init -.task) ?: ?=(%init -.task)

View File

@ -433,7 +433,7 @@
|- ^+ mo-core |- ^+ mo-core
?~ agents ?~ agents
mo-core mo-core
=. mo-core =? mo-core ?=(%live -.yoke.i.agents)
=/ =routes [disclosing=~ attributing=ship] =/ =routes [disclosing=~ attributing=ship]
=/ app (ap-abed:ap name.i.agents routes) =/ app (ap-abed:ap name.i.agents routes)
ap-abet:(ap-breach:app ship) ap-abet:(ap-breach:app ship)
@ -474,12 +474,12 @@
?> ?=([%lag ~] wire) ?> ?=([%lag ~] wire)
?> ?=([%ames %clog *] sign-arvo) ?> ?=([%ames %clog *] sign-arvo)
:: ::
=/ agents=(list term) ~(tap in ~(key by yokes.state)) =/ agents=(list [=dude =yoke]) ~(tap by yokes.state)
|- ^+ mo-core |- ^+ mo-core
?~ agents mo-core ?~ agents mo-core
:: ::
=. mo-core =? mo-core ?=(%live -.yoke.i.agents)
=/ app (ap-abed:ap i.agents `our) =/ app (ap-abed:ap dude.i.agents `our)
ap-abet:(ap-clog:app ship.sign-arvo) ap-abet:(ap-clog:app ship.sign-arvo)
:: ::
$(agents t.agents) $(agents t.agents)
@ -704,7 +704,8 @@
++ mo-idle ++ mo-idle
|= dap=dude |= dap=dude
^+ mo-core ^+ mo-core
?. (~(has by yokes.state) dap) =/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %idle for {<dap>}, not running" ~> %slog.0^leaf/"gall: ignoring %idle for {<dap>}, not running"
mo-core mo-core
ap-abet:ap-idle:(ap-abed:ap dap `our) ap-abet:ap-idle:(ap-abed:ap dap `our)
@ -713,14 +714,15 @@
++ mo-nuke ++ mo-nuke
|= dap=dude |= dap=dude
^+ mo-core ^+ mo-core
?. (~(has by yokes.state) dap) =/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %nuke for {<dap>}, not running" ~> %slog.0^leaf/"gall: ignoring %nuke for {<dap>}, not running"
mo-core mo-core
~> %slog.0^leaf/"gall: nuking {<dap>}" ~> %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)
=- mo-core(yokes.state -) =- mo-core(yokes.state -)
%+ ~(jab by yokes.state) dap %+ ~(jab by yokes.state) dap
|= =yoke |= =^yoke
?: ?=(%nuke -.yoke) yoke ?: ?=(%nuke -.yoke) yoke
:- %nuke :- %nuke
%- ~(run by sky.yoke) %- ~(run by sky.yoke)
@ -755,6 +757,7 @@
|= [veb=? dap=term =routes care=term =path] |= [veb=? dap=term =routes care=term =path]
^- (unit (unit cage)) ^- (unit (unit cage))
:: ::
?. ?=([~ %live *] (~(get by yokes.state) dap)) [~ ~]
=/ app (ap-abed:ap dap routes) =/ app (ap-abed:ap dap routes)
(ap-peek:app veb care path) (ap-peek:app veb care path)
:: ::
@ -766,6 +769,10 @@
(mo-apply-sure dap routes deal) (mo-apply-sure dap routes deal)
:: ::
%raw-poke %raw-poke
:: don't validate %noun pokes, for performance
::
?: =(%noun mark.deal)
(mo-apply-sure dap routes [%poke %noun %noun noun.deal])
=/ =case da+now =/ =case da+now
=/ yok (~(got by yokes.state) dap) =/ yok (~(got by yokes.state) dap)
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion? =/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
@ -970,7 +977,7 @@
++ ap-idle ++ ap-idle
^+ ap-core ^+ ap-core
?: ?=(%| -.agent.yoke) ap-core ?: ?=(%| -.agent.yoke) ap-core
=> [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all *agent]))] => [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all p.agent.yoke]))]
ap-core(ken.yoke ken, agent.yoke |+on-save:ap-agent-core) ap-core(ken.yoke ken, agent.yoke |+on-save:ap-agent-core)
:: ::
++ ap-nuke ++ ap-nuke