urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-25 04:52:06 +03:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
yosoyubik 2023-05-05 09:53:01 +02:00
commit df47808047
22 changed files with 711 additions and 621 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CONTRIBUTING.md
View File

@ -167,7 +167,7 @@ should be accompanied by an updated [solid pill](#the-kernel-and-pills). Pills
are tracked in the repository via [git LFS][git-lfs].
```
$ git lfs init
$ git lfs install
$ git lfs pull
```
@ -185,7 +185,7 @@ directory as `urbit.pill`.
You can boot a new ship from your local pill with `-B`:
```
$ urbit -F zod -B path/to/urbit.pill my-fake-zod
$ urbit -F zod -B path/to/urbit.pill -c my-fake-zod
```
Release pills, i.e. those corresponding to vere releases, are cached at

15
MAINTAINERS.md
View File

@ -13,15 +13,12 @@ also simple to reason about.
The branches and their corresponding moons that comprise the stages of the
release pipeline are:
```
----------------------------------------------------------------------------------------------
Branch | Moon | Target audience | Contains
----------------------------------------------------------------------------------------------
`develop` | `~binnec-dozzod-marzod` | Kernel developers | Latest `develop` branch commit
`release` | `~marnec-dozzod-marzod` | Early Adopters | Latest `release` branch commit
`release` | `~doznec-dozzod-marzod` | App Developers | Latest release candidate
`master` | `~zod` | Everyone else | Latest release
```
| Branch | Moon | Target Audience | Contains |
|:---------:|:-----------------------:|:-----------------:|:------------------------------:|
| `develop` | `~binnec-dozzod-marzod` | Kernel Developers | Latest `develop` branch commit |
| `release` | `~marnec-dozzod-marzod` | Early Adopters | Latest `release` branch commit |
| `release` | `~doznec-dozzod-marzod` | App Developers | Latest release candidate |
| `master` | `~zod` | Everyone Else | Latest release |
**WARNING**: If you lack the requisite skills to troubleshoot and fix kernel issues, you should not sync from develop/~binnec. If you're not prepared to breach your ship in response to an issue stemming from an early release, do not use pre-release moons.

4
pkg/arvo/app/dbug.hoon
View File

@ -831,7 +831,9 @@
|= keen-state
|^ ^- json
%- pairs
:~ 'wan'^a/(turn (tap:(deq want) wan) wants)
:~ :- %wan
a/(turn (tap:((on @ud want) lte) wan) |=([@ a=_+6:wants] (wants a)))
::
'nex'^a/(turn nex wants)
::
:- 'hav'

95
pkg/arvo/app/spider.hoon
View File

@ -15,7 +15,7 @@
running=(axal thread-form)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
scries=(map tid [=ship =path])
scrying=(jug tid [=wire =ship =path])
==
::
+$ clean-slate-any
@ -25,16 +25,26 @@
clean-slate-2
clean-slate-3
clean-slate-4
clean-slate-5
clean-slate
==
::
+$ clean-slate
$: %6
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
scrying=(jug tid [wire ship path])
==
::
+$ clean-slate-5
$: %5
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
scries=(map tid [ship path])
scrying=(map tid [ship path])
==
::
+$ clean-slate-4
@ -110,7 +120,8 @@
=. any (old-to-3 any)
=. any (old-to-4 any)
=. any (old-to-5 any)
?> ?=(%5 -.any)
=. any (old-to-6 any)
?> ?=(%6 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
@ -120,7 +131,11 @@
?~ yarns
[~[bind-eyre:sc] this]
=^ cards-1 state
(handle-stop-thread:sc (yarn-to-tid i.yarns) |)
%. [(yarn-to-tid i.yarns) nice=%.n]
:: the |sc core needs to now about the previous
:: scrying state in order to send $yawns to %ames
::
%*(handle-stop-thread sc scrying.state scrying.any)
=^ cards-2 this
$(yarns t.yarns)
[:(weld upgrade-cards cards-1 cards-2) this]
@ -133,8 +148,8 @@
++ old-to-2
|= old=clean-slate-any
^- (quip card clean-slate-any)
?> ?=(?(%1 %2 %3 %4 %5) -.old)
?: ?=(?(%2 %3 %4 %5) -.old)
?> ?=(?(%1 %2 %3 %4 %5 %6) -.old)
?: ?=(?(%2 %3 %4 %5 %6) -.old)
`old
:- ~[bind-eyre:sc]
:* %2
@ -147,8 +162,8 @@
++ old-to-3
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%2 %3 %4 %5) -.old)
?: ?=(?(%3 %4 %5) -.old)
?> ?=(?(%2 %3 %4 %5 %6) -.old)
?: ?=(?(%3 %4 %5 %6) -.old)
old
:* %3
starting.old
@ -156,11 +171,12 @@
tid.old
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
==
::
++ old-to-4
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%3 %4 %5) -.old)
?: ?=(?(%4 %5) -.old)
?> ?=(?(%3 %4 %5 %6) -.old)
?: ?=(?(%4 %5 %6) -.old)
old
:* %4
starting.old
@ -171,10 +187,27 @@
::
++ old-to-5
|= old=clean-slate-any
^- clean-slate
?> ?=(?(%4 %5) -.old)
?: ?=(%5 -.old) old
^- clean-slate-any
?> ?=(?(%4 %5 %6) -.old)
?: ?=(?(%5 %6) -.old) old
[%5 +.old(serving [serving.old ~])]
::
++ old-to-6
|= old=clean-slate-any
^- clean-slate
?> ?=(?(%5 %6) -.old)
?: ?=(%6 -.old) old
:- %6
%= +.old
scrying
%- ~(run by scrying.old)
|= [=ship =path]
%- ~(gas in *(set [wire ^ship ^path]))
:: XX +keen:strandio used /keen as the default wire
:: this assumes that any old thread used that as well
::
[/keen ship path]~
==
--
::
++ on-poke
@ -421,14 +454,13 @@
?: (~(has of running.state) u.yarn)
?. nice
(thread-fail u.yarn %cancelled ~)
=^ cancel-cards state (cancel-scry tid &)
=^ done-cards state (thread-done u.yarn *vase)
[(weld cancel-cards done-cards) state]
=^ done-cards state (thread-done u.yarn *vase silent=%.n)
[done-cards state]
?: (~(has by starting.state) u.yarn)
(thread-fail-not-running tid %stopped-before-started ~)
~& [%thread-not-started u.yarn]
?: nice
(thread-done u.yarn *vase)
(thread-done u.yarn *vase silent=%.y)
(thread-fail u.yarn %cancelled ~)
::
++ take-input
@ -457,8 +489,8 @@
^- [(list card) _state]
%+ roll cards.r
|= [=card cards=(list card) s=_state]
:_ =? scries.s ?=([%pass ^ %arvo %a %keen @ *] card)
(~(put by scries.s) tid &6.card +>+>+>.card)
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen @ *] card)
(~(put ju scrying.s) tid [&2 &6 |6]:card)
s
:_ cards
^- ^card
@ -476,7 +508,7 @@
?- -.eval-result.r
%next `state
%fail (thread-fail yarn err.eval-result.r)
%done (thread-done yarn value.eval-result.r)
%done (thread-done yarn value.eval-result.r silent=%.y)
==
[(weld cards final-cards) state]
::
@ -500,12 +532,15 @@
++ cancel-scry
|= [=tid silent=?]
^- (quip card _state)
?~ scry=(~(get by scries.state) tid)
?~ scrying=(~(get ju scrying.state) tid)
`state
:_ state(scries (~(del by scries.state) tid))
:_ state(scrying (~(del by scrying.state) tid))
?: silent ~
%- (slog leaf+"cancelling {<tid>}: [{<[ship path]:u.scry>}]" ~)
[%pass /thread/[tid]/keen %arvo %a %yawn [ship path]:u.scry]~
%- ~(rep in `(set [wire ship path])`scrying)
|= [[=wire =ship =path] cards=(list card)]
%- (slog leaf+"cancelling {<tid>}: [{<[wire ship path]>}]" ~)
:_ cards
[%pass (welp /thread/[tid] wire) %arvo %a %yawn ship path]
::
++ thread-http-fail
|= [=tid =term =tang]
@ -535,9 +570,9 @@
::%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
=^ cards state (thread-clean yarn)
=^ http-cards state (thread-http-fail tid term tang)
=^ scry-card state (cancel-scry tid |)
=^ scry-card state (cancel-scry tid silent=%.n)
:_ state
:(weld fail-cards cards http-cards scry-card)
::
@ -556,7 +591,7 @@
(json-response:gen:server !<(json (tube vase)))
::
++ thread-done
|= [=yarn =vase]
|= [=yarn =vase silent=?]
^- (quip card ^state)
:: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~)
=/ =tid (yarn-to-tid yarn)
@ -566,8 +601,8 @@
==
=^ http-cards state
(thread-http-response tid vase)
=^ scry-card state (cancel-scry tid &)
=^ cards state (thread-clean yarn)
=^ scry-card state (cancel-scry tid silent)
=^ cards state (thread-clean yarn)
[:(weld done-cards cards http-cards scry-card) state]
::
++ thread-clean
@ -640,7 +675,7 @@
::
++ clean-state
!> ^- clean-slate
5+state(running (turn ~(tap of running.state) head))
6+state(running (turn ~(tap of running.state) head))
::
++ convert-tube
|= [from=mark to=mark =desk =bowl:gall]

2
pkg/arvo/gen/vat.hoon
View File

@ -1,7 +1,7 @@
/- *hood
:- %say
|= [[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"
(report-vat (report-prep p.bec now) p.bec now syd verb)
==

21
pkg/arvo/gen/vats.hoon
View File

@ -12,10 +12,17 @@
::
/- *hood
:- %say
|= [[now=@da * bec=beak] deks=$@(~ (list desk)) filt=@tas verb=_|]
?: &(=(~ deks) =(%$ filt))
:- %tang
%+ turn
~(tap in .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now)))
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))
[%tang (report-vats p.bec now deks filt verb)]
|= $: [now=@da * bec=beak]
deks=(list desk)
[filt=@tas verb=_|]
==
:- %tang ^- tang
?. &(=(~ deks) =(%$ filt))
(report-vats p.bec now deks filt verb)
%- zing
%+ turn
%+ sort
=/ sed .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now))
(sort ~(tap in sed) |=([a=@ b=@] !(aor a b)))
|=([a=desk b=desk] ?|(=(a %kids) =(b %base)))
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))

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

@ -11470,9 +11470,15 @@
:: 5d: parser
+| %parser
::
++ vang :: set ++vast params
|= [bug=? wer=path] :: bug: debug mode
%*(. vast bug bug, wer wer) :: wer: where we are
:: +vang: set +vast params
::
:: bug: debug mode
:: doc: doccord parsing
:: wer: where we are
::
++ vang
|= [f=$@(? [bug=? doc=?]) wer=path]
%*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer)
::
++ vast :: main parsing core
=+ [bug=`?`| wer=*path doc=`?`&]
@ -13486,7 +13492,7 @@
;~ pose
%+ ifix
[;~(plug lus tar muck) muck]
(most muck ;~(gunk sym loaf))
(most muck ;~(gunk sym loll))
::
(easy ~)
==
@ -13563,6 +13569,7 @@
++ hunk (most mush loan) :: gapped specs
++ jump ;~(pose leap:docs gap) :: gap before docs
++ loaf ?:(tol tall wide) :: hoon
++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
++ loan ?:(tol till wyde) :: spec
++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
@ -13612,7 +13619,7 @@
++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
++ expe |.(wisp) :: core tail
++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon
++ expg |.(;~(goop lomp loaf loaf)) :: term/spec, two hoons
++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons
++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
++ expj |.(;~(goop lore loaf)) :: skin and hoon

35
pkg/arvo/sys/lull.hoon
View File

@ -36,27 +36,6 @@
max-size=_2.048
depth=_1
==
::
:: +afx: polymorphic node type for finger trees
::
++ afx
|$ [val]
$% [%1 p=val ~]
[%2 p=val q=val ~]
[%3 p=val q=val r=val ~]
[%4 p=val q=val r=val s=val ~]
==
::
:: +pha: finger tree
::
++ pha
|$ [val]
$~ [%nul ~]
$% [%nul ~]
[%one p=val]
[%big p=(afx val) q=(pha val) r=(afx val)]
==
::
:: +mop: constructs and validates ordered ordered map based on key,
:: val, and comparator gate
::
@ -461,6 +440,13 @@
?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a)
:: +wyt: measure size
::
++ wyt
~/ %wyt
|= a=(tree item)
^- @ud
?~(a 0 +((add $(a l.a) $(a r.a))))
--
::
+$ deco ?(~ %bl %br %un) :: text decoration
@ -1029,9 +1015,9 @@
keens=(map path keen-state)
==
+$ keen-state
$: wan=(pha want) :: request packets, sent
nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward
$: wan=((mop @ud want) lte) :: request packets, sent
nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward
num-fragments=@ud
num-received=@ud
next-wake=(unit @da)
@ -1182,7 +1168,6 @@
?: (gth message-num.a message-num.b)
%.n
(lte fragment-num.a fragment-num.b)
::
:: $pump-metrics: congestion control state for a |packet-pump
::
:: This is an Ames adaptation of TCP's Reno congestion control

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

@ -777,6 +777,301 @@
++ com |~(a=pass ^?(..nu))
--
--
::
+$ ames-state-13
$: peers=(map ship ship-state-13)
=unix=duct
=life
=rift
crypto-core=acru:ames
=bug
snub=[form=?(%allow %deny) ships=(set ship)]
cong=[msg=@ud mem=@ud]
==
::
+$ ship-state-13
$% [%alien alien-agenda]
[%known peer-state-13]
==
::
+$ peer-state-13
$: $: =symmetric-key
=life
=rift
=public-key
sponsor=ship
==
route=(unit [direct=? =lane])
=qos
=ossuary
snd=(map bone message-pump-state)
rcv=(map bone message-sink-state)
nax=(set [=bone =message-num])
heeds=(set duct)
closing=(set bone)
corked=(set bone)
keens=(map path keen-state-13)
==
::
++ keen-state-13
=< $: wan=(pha want) :: request packts, sent
nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward
num-fragments=@ud
num-received=@ud
next-wake=(unit @da)
listeners=(set duct)
metrics=pump-metrics
==
|%
:: +afx: polymorphic node type for finger trees
::
++ afx
|$ [val]
$% [%1 p=val ~]
[%2 p=val q=val ~]
[%3 p=val q=val r=val ~]
[%4 p=val q=val r=val s=val ~]
==
:: +pha: finger tree
::
:: DO NOT USE THIS
:: It's wrong and only kept around for state migration purposes.
::
++ pha
|$ [val]
$~ [%nul ~]
$% [%nul ~]
[%one p=val]
[%big p=(afx val) q=(pha val) r=(afx val)]
==
:: +deq: deque
::
:: DO NOT USE THIS
:: It's wrong and only kept around for state migration purposes.
::
++ deq
|* val=mold
|%
:: ::
:: :: +| %utilities
:: ::
:: ++ make-afx
:: |= ls=(list val)
:: ?+ ls ~|(bad-finger/(lent ls) !!)
:: [* ~] [%1 ls]
:: [* * ~] [%2 ls]
:: [* * * ~] [%3 ls]
:: [* * * * ~] [%4 ls]
:: ==
:: ++ afx-to-pha
:: |= =(afx val)
:: ^- (pha val)
:: (apl *(pha val) +.afx)
:: ::
:: :: +| %left-biased-operations
:: ::
:: :: +pop-left: remove leftmost value from tree
:: ::
:: ++ pop-left
:: |= a=(pha val)
:: ^- [val=(unit val) pha=(pha val)]
:: ?- -.a
:: %nul ~^a
:: ::
:: %one [`p.a nul/~]
:: ::
:: %big
:: [`p.p.a (big-left +.+.p.a q.a r.a)]
:: ==
:: ++ apl
:: |= [a=(pha val) vals=(list val)]
:: ^- (pha val)
:: =. vals (flop vals)
:: |-
:: ?~ vals a
:: $(a (cons a i.vals), vals t.vals)
:: ::
:: ::
:: ++ dip-left
:: |* state=mold
:: |= $: a=(pha val)
:: =state
:: f=$-([state val] [(unit val) ? state])
:: ==
:: ^+ [state a]
:: =/ acc [stop=`?`%.n state=state]
:: =| new=(pha val)
:: |-
:: ?: stop.acc
:: :: cat new and old
:: [state.acc (weld a new)]
:: =^ val=(unit val) a
:: (pop-left a)
:: ?~ val
:: [state.acc new]
:: =^ res=(unit ^val) acc
:: (f state.acc u.val)
:: ?~ res $
:: $(new (snoc new u.res))
:: ::
:: ++ big-left
:: |= [ls=(list val) a=(pha val) sf=(afx val)]
:: ^- (pha val)
:: ?. =(~ ls)
:: [%big (make-afx ls) a sf]
:: =/ [val=(unit val) inner=_a]
:: (pop-left a)
:: ?~ val
:: (afx-to-pha sf)
:: [%big [%1 u.val ~] inner sf]
:: ::
:: ++ cons
:: =| b=(list val)
:: |= [a=(pha val) c=val]
:: ^- (pha val)
:: =. b [c b]
:: |-
:: ?~ b a
:: ?- -.a
:: ::
:: %nul
:: $(a [%one i.b], b t.b)
:: ::
:: %one
:: %= $
:: b t.b
:: a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]]
:: ==
:: ::
:: %big
:: ?. ?=(%4 -.p.a)
:: %= $
:: b t.b
:: ::
:: a
:: ?- -.p.a
:: %1 big/[[%2 i.b p.p.a ~] q.a r.a]
:: %2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a]
:: %3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a]
:: ==
:: ==
:: =/ inner
:: $(a q.a, b ~[s.p.a r.p.a q.p.a])
:: =. inner
:: $(a inner, b t.b)
:: big/[[%2 i.b p.p.a ~] inner r.a]
:: ==
:: ::
:: :: +| %right-biased-operations
:: ::
:: :: +snoc: append to end (right) of tree
:: ::
:: ++ snoc
:: |= [a=(pha val) b=val]
:: ^+ a
:: ?- -.a
:: %nul [%one b]
:: ::
:: %one
:: :- %big
:: :* [%1 p.a ~]
:: [%nul ~]
:: [%1 b ~]
:: ==
:: ::
:: %big
:: ?- -.r.a
:: ::
:: %1
:: :- %big
:: [p.a q.a [%2 p.r.a b ~]]
:: ::
:: %2
:: :- %big
:: [p.a q.a [%3 p.r.a q.r.a b ~]]
:: ::
:: %3
:: :- %big
:: [p.a q.a [%4 p.r.a q.r.a r.r.a b ~]]
:: ::
:: %4
:: =/ inner
:: $(a q.a, b p.r.a)
:: =. inner
:: $(a inner, b q.r.a)
:: =. inner
:: $(a inner, b r.r.a)
:: :- %big
:: :* p.a
:: inner
:: [%2 s.r.a b ~]
:: ==
:: ==
:: ==
:: :: +apr: append list to end (right) of tree
:: ::
:: ++ apr
:: |= [a=(pha val) vals=(list val)]
:: ^- (pha val)
:: ?~ vals a
:: $(a (snoc a i.vals), vals t.vals)
:: :: +| %manipulation
:: ::
:: :: +weld: concatenate two trees
:: ::
:: :: O(log n)
:: ++ weld
:: =| c=(list val)
:: |= [a=(pha val) b=(pha val)]
:: ^- (pha val)
:: ?- -.b
:: %nul (apr a c)
:: %one (snoc (apr a c) p.b)
:: ::
:: %big
:: ?- -.a
:: %nul (apl b c)
:: %one (cons (apl b c) p.a)
:: ::
:: %big
:: :- %big
:: =- [p.a - r.b]
:: $(a q.a, b q.b, c :(welp +.r.a c +.p.b))
:: ==
:: ==
:: +tap: transform tree to list
::
++ tap
=| res=(list val)
|= a=(pha val)
!.
|^ ^+ res
?- -.a
%nul ~
%one ~[p.a]
::
%big
=/ fst=_res
(tap-afx p.a)
=/ lst=_res
(tap-afx r.a)
=/ mid=_res
$(a q.a)
:(welp fst mid lst)
==
++ tap-afx
|= ax=(afx val)
^+ res
?- -.ax
%1 +.ax
%2 +.ax
%3 +.ax
%4 +.ax
==
--
--
--
:: $bug: debug printing configuration
::
:: veb: verbosity toggles
@ -909,7 +1204,8 @@
[%10 ames-state-10]
[%11 ames-state-11]
[%12 ames-state-12]
[%13 ^ames-state]
[%13 ames-state-13]
[%14 ^ames-state]
==
::
|= [now=@da eny=@ rof=roof]
@ -1032,7 +1328,7 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames
::
++ scry scry:adult-core
++ stay [%13 %larva queued-events ames-state.adult-gate]
++ stay [%14 %larva queued-events ames-state.adult-gate]
++ load
|= $= old
$% $: %4
@ -1099,6 +1395,13 @@
[%adult state=ames-state-12]
== ==
$: %13
$% $: %larva
events=(qeu queued-event)
state=ames-state-13
==
[%adult state=ames-state-13]
== ==
$: %14
$% $: %larva
events=(qeu queued-event)
state=_ames-state.adult-gate
@ -1113,7 +1416,7 @@
=. state.old (state-4-to-5:load:adult-core state.old)
$(-.old %5)
::
[%5 %adult *]
[%5 %adult *]
=. cached-state `[%5 state.old]
~> %slog.0^leaf/"ames: larva reload"
larval-gate
@ -1201,14 +1504,24 @@
=. queued-events events.old
larval-gate
::
[%13 %adult *] (load:adult-core %13 state.old)
[%13 %adult *]
=. cached-state `[%13 state.old]
~> %slog.0^leaf/"ames: larva reload"
larval-gate
::
[%13 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. cached-state `[%13 state.old]
=. queued-events events.old
=. adult-gate (load:adult-core %13 state.old)
larval-gate
::
[%14 %adult *] (load:adult-core %14 state.old)
::
[%14 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %14 state.old)
larval-gate
==
::
++ event-11-to-12
@ -1250,7 +1563,9 @@
12+(state-11-to-12:load:adult-core +.u.cached-state)
=? u.cached-state ?=(%12 -.u.cached-state)
13+(state-12-to-13:load:adult-core +.u.cached-state)
?> ?=(%13 -.u.cached-state)
=? u.cached-state ?=(%13 -.u.cached-state)
14+(state-13-to-14:load:adult-core +.u.cached-state)
?> ?=(%14 -.u.cached-state)
=. ames-state.adult-gate +.u.cached-state
[moz larval-core(cached-state ~)]
--
@ -3829,8 +4144,8 @@
(trace %fine verb her ships.bug.ames-state print)
::
++ fi-emit |=(move fine(event-core (emit +<)))
++ fi-deq (deq want)
++ fi-gauge (ga metrics.keen (wyt:fi-deq wan.keen))
++ fi-mop ((on @ud want) lte)
++ fi-gauge (ga metrics.keen (wyt:fi-mop wan.keen))
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
::
@ -3854,7 +4169,7 @@
=/ fra=@ 1
=/ req=hoot (fi-etch-wail fra)
=/ =want [fra req last=now tries=1 skips=0]
=. wan.keen (cons:fi-deq *(pha ^want) want)
=. wan.keen (put:fi-mop ~ [fra .]:want)
(fi-send `@ux`req)
::
++ fi-rcv
@ -3924,12 +4239,12 @@
=| marked=(list want)
|= fra=@ud
^- [? _fine]
=; [[found=? cor=_fine] wan=(pha want)]
=; [[found=? cor=_fine] wan=_wan.keen]
:- found
?.(found fine cor(wan.keen wan))
%^ (dip-left:fi-deq ,[found=? cor=_fine]) wan.keen
%^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
[| fine]
|= [[found=? cor=_fine] =want]
|= [[found=? cor=_fine] @ud =want]
^- [(unit _want) stop=? [found=? cor=_fine]]
=. fine cor
?: =(fra fra.want)
@ -3980,7 +4295,7 @@
=^ =want nex.keen nex.keen
=. last-sent.want now
=. tries.want +(tries.want)
=. wan.keen (snoc:fi-deq wan.keen want)
=. wan.keen (put:fi-mop wan.keen [fra .]:want)
=. fine (fi-send `@ux`hoot.want)
$(inx +(inx))
::
@ -3996,11 +4311,11 @@
::
++ fi-fast-retransmit
|= fra=@ud
=; [cor=_fine wants=(pha want)]
=; [cor=_fine wants=_wan.keen]
cor(wan.keen wants)
%^ (dip-left:fi-deq ,cor=_fine) wan.keen
%^ (dip:fi-mop ,cor=_fine) wan.keen
fine
|= [cor=_fine =want]
|= [cor=_fine @ud =want]
^- [(unit ^want) stop=? cor=_fine]
?. (lte fra.want fra)
[`want & cor]
@ -4018,9 +4333,9 @@
++ fi-set-wake
^+ fine
=/ next-wake=(unit @da)
?~ want=(peek-left:fi-deq wan.keen)
?~ want=(pry:fi-mop wan.keen)
~
`(next-expiry:fi-gauge +>:u.want)
`(next-expiry:fi-gauge +>:val.u.want)
?: =(next-wake next-wake.keen)
fine
=? fine !=(~ next-wake.keen)
@ -4042,13 +4357,14 @@
=. peer-state (update-peer-route her peer-state)
=. metrics.keen on-timeout:fi-gauge
=^ want=(unit want) wan.keen
(pop-left:fi-deq wan.keen)
?~ res=(pry:fi-mop wan.keen) `wan.keen
(del:fi-mop wan.keen key.u.res)
~| %took-wake-for-empty-want
?> ?=(^ want)
=: tries.u.want +(tries.u.want)
last-sent.u.want now
==
=. wan.keen (cons:fi-deq wan.keen u.want)
=. wan.keen (put:fi-mop wan.keen [fra .]:u.want)
(fi-send `@ux`hoot.u.want)
--
:: +ga: constructor for |pump-gauge congestion control core
@ -4267,15 +4583,15 @@
[moves ames-gate]
:: +stay: extract state before reload
::
++ stay [%13 %adult ames-state]
++ stay [%14 %adult ames-state]
:: +load: load in old state after reload
::
++ load
=< |= $= old-state
$% [%13 ^ames-state]
$% [%14 ^ames-state]
==
^+ ames-gate
?> ?=(%13 -.old-state)
?> ?=(%14 -.old-state)
ames-gate(ames-state +.old-state)
:: all state transitions are called from larval ames
::
@ -4394,7 +4710,7 @@
::
++ state-12-to-13
|= old=ames-state-12
^- ^ames-state
^- ames-state-13
=+ !< =rift
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
=+ pk=sec:ex:crypto-core.old
@ -4412,10 +4728,27 @@
::
++ ship-state-12-to-13
|= old=ship-state-12
^- ship-state
^- ship-state-13
?: ?=(%alien -.old)
old(heeds [heeds.old ~])
old(corked [corked.old ~])
::
++ state-13-to-14
|= old=ames-state-13
^- ^ames-state
=- old(peers -)
%- ~(run by peers.old)
|= old=ship-state-13
?: ?=(%alien -.old) old
old(keens (~(run by keens.old) keen-state-13-to-14))
::
++ keen-state-13-to-14
|= old=keen-state-13
^- keen-state
=- old(wan -)
%+ gas:((on @ud want) lte) ~
%+ turn (tap:(deq:keen-state-13 want) wan.old)
|= =want [fra .]:want
--
:: +scry: dereference namespace
::

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

@ -925,7 +925,9 @@
~/ %parse-pile
|= [pax=path tex=tape]
^- pile
=/ [=hair res=(unit [=pile =nail])] ((pile-rule pax) [1 1] tex)
=/ [=hair res=(unit [=pile =nail])]
%- road |.
((pile-rule pax) [1 1] tex)
?^ res pile.u.res
%- mean %- flop
=/ lyn p.hair
@ -4243,7 +4245,7 @@
:: +read-s: produce miscellaneous
::
++ read-s
|= [tak=tako pax=path]
|= [tak=tako pax=path =case]
^- (unit (unit cage))
?: ?=([%subs ~] pax)
?. =([%da now] case) ~
@ -4514,7 +4516,7 @@
%f (read-f tak path.mun)
%p [(read-p path.mun) ..park]
%r (read-r tak path.mun)
%s [(read-s tak path.mun) ..park]
%s [(read-s tak path.mun case.mun) ..park]
%t [(read-t tak path.mun) ..park]
%u [(read-u tak path.mun) ..park]
%v [(read-v tak path.mun) ..park]
@ -4558,7 +4560,8 @@
|* [her=ship syd=desk yon=(unit aeon) res=* =state:ford:fusion]
=^ moves ruf
=/ den ((de now rof hen ruf) her syd)
abet:+:(tako-flow:den ?~(yon let.dom:den u.yon) res cache.state &2.state)
=/ tak (aeon-to-tako:ze:den ?~(yon let.dom:den u.yon))
abet:+:(tako-flow:den tak res cache.state &2.state)
[res (emil moves)]
::
++ trace

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

@ -656,7 +656,8 @@
=/ connection=outstanding-connection
[action [authenticated secure address request] ~ 0]
=. connections.state
:: XX pretty sure this is superfluous - done in +handle-response
:: NB: required by +handle-response. XX optimize
::
(~(put by connections.state) duct connection)
:: redirect to https if insecure, redirects enabled
:: and secure port live
@ -1986,7 +1987,10 @@
|= =tang
^- [(list move) server-state]
::
=+ connection=(~(got by connections.state) duct)
?~ connection-state=(~(get by connections.state) duct)
%. `state
(trace 0 |.("{<duct>} error on invalid outstanding connection"))
=* connection u.connection-state
=/ moves-1=(list move)
?. ?=(%app -.action.connection)
~
@ -2055,8 +2059,8 @@
(session-cookie-string u.session-id &)
headers.response-header.http-event
::
=/ connection=outstanding-connection
(~(got by connections.state) duct)
=* connection u.connection-state
::
:: if the request was a simple cors request from an approved origin
:: append the necessary cors headers to the response
::
@ -2073,16 +2077,18 @@
::
=. response-header.http-event response-header
=. connections.state
?: complete.http-event
:: XX optimize by not requiring +put:by in +request
::
(~(del by connections.state) duct)
::
%- (trace 2 |.("{<duct>} start"))
%+ ~(put by connections.state) duct
%_ connection
%= connection
response-header `response-header
bytes-sent ?~(data.http-event 0 p.u.data.http-event)
==
::
=? state complete.http-event
log-complete-request
::
pass-response
::
%continue
@ -2091,14 +2097,18 @@
(trace 0 |.("{<duct>} error continue without start"))
::
=. connections.state
%- (trace 2 |.("{<duct>} continuing "))
%+ ~(jab by connections.state) duct
|= connection=outstanding-connection
=+ size=?~(data.http-event 0 p.u.data.http-event)
connection(bytes-sent (add bytes-sent.connection size))
::
=? state complete.http-event
log-complete-request
?: complete.http-event
%- (trace 2 |.("{<duct>} completed"))
(~(del by connections.state) duct)
::
%- (trace 2 |.("{<duct>} continuing"))
?~ data.http-event
connections.state
::
%+ ~(put by connections.state) duct
=* size p.u.data.http-event
=* conn u.connection-state
conn(bytes-sent (add size bytes-sent.conn))
::
pass-response
::
@ -2112,16 +2122,6 @@
^- [(list move) server-state]
[[duct %give %response http-event]~ state]
::
++ log-complete-request
:: todo: log the complete request
::
:: remove all outstanding state for this connection
::
=. connections.state
%. (~(del by connections.state) duct)
(trace 2 |.("{<duct>} completed"))
state
::
++ error-connection
:: todo: log application error
::

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

@ -42,9 +42,9 @@
:: $move: Arvo-level move
::
+$ move [=duct move=(wind note-arvo gift-arvo)]
:: $state-12: overall gall state, versioned
:: $state-13: overall gall state, versioned
::
+$ state-12 [%12 state]
+$ state-13 [%13 state]
:: $state: overall gall state
::
:: system-duct: TODO document
@ -82,6 +82,7 @@
:: beak: compilation source
:: marks: mark conversion requests
:: sky: scry bindings
:: ken: open keen requests
::
+$ yoke
$% [%nuke sky=(map spur @ud)]
@ -98,6 +99,7 @@
=beak
marks=(map duct mark)
sky=(map spur path-state)
ken=(jug spar:ames wire)
== ==
::
+$ path-state
@ -160,7 +162,7 @@
:: $spore: structures for update, produced by +stay
::
+$ spore
$: %12
$: %13
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
@ -185,11 +187,12 @@
=beak
marks=(map duct mark)
sky=(map spur path-state)
ken=(jug spar:ames wire)
== ==
--
:: adult gall vane interface, for type compatibility with pupa
::
=| state=state-12
=| state=state-13
|= [now=@da eny=@uvJ rof=roof]
=* gall-payload .
~% %gall-top ..part ~
@ -955,9 +958,20 @@
moves moves
==
::
++ ap-yawn-all
^- (list card:agent)
%- zing
%+ turn ~(tap by ken.yoke)
|= [=spar:ames wyz=(set wire)]
%+ turn ~(tap in wyz)
|= =wire
[%pass wire %arvo %a %yawn spar]
::
++ ap-idle
^+ ap-core
?: ?=(%| -.agent.yoke) ap-core
ap-core(agent.yoke |+on-save:ap-agent-core)
=> [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all *agent]))]
ap-core(ken.yoke ken, agent.yoke |+on-save:ap-agent-core)
::
++ ap-nuke
^+ ap-core
@ -967,13 +981,17 @@
|= [=duct =ship =path]
path
=/ will=(list card:agent)
%+ welp
;: welp
?: =(~ inbound-paths)
~
[%give %kick ~(tap in inbound-paths) ~]~
%+ turn ~(tap by boat.yoke)
|= [[=wire =dock] ? =path]
[%pass wire %agent dock %leave ~]
::
%+ turn ~(tap by boat.yoke)
|= [[=wire =dock] ? =path]
[%pass wire %agent dock %leave ~]
::
ap-yawn-all
==
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
ap-core
:: +ap-grow: bind a path in the agent's scry namespace
@ -1310,6 +1328,12 @@
?: ?=(%& -.agent.yoke)
on-save:ap-agent-core
p.agent.yoke
=? ap-core &(?=(%| -.agent.yoke) ?=(^ ken.yoke))
=- +:(ap-ingest ~ |.([+< agent]))
%- zing
%+ turn ~(tap by `(jug spar:ames wire)`ken.yoke)
|= [=spar:ames wyz=(set wire)]
(turn ~(tap in wyz) |=(=wire [%pass wire %arvo %a %keen spar]))
=^ error ap-core
(ap-install(agent.yoke &+agent) `old-state)
?~ error
@ -1365,6 +1389,8 @@
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(on-arvo:ap-agent-core wire sign-arvo)
=? ken.yoke ?=([%ames %tune spar=* *] sign-arvo)
(~(del ju ken.yoke) spar.sign-arvo wire)
?^ maybe-tang
(ap-error %arvo-response u.maybe-tang)
ap-core
@ -1714,6 +1740,7 @@
::
=. agent.yoke &++.p.result
=^ fex ap-core (ap-handle-sky -.p.result)
=. ken.yoke (ap-handle-ken fex)
=/ moves (zing (turn fex ap-from-internal))
=. bitt.yoke (ap-handle-kicks moves)
(ap-handle-peers moves)
@ -1732,6 +1759,17 @@
[%give *] $(caz t.caz, fex [i.caz fex])
[%slip *] !!
==
:: +ap-handle-ken
::
++ ap-handle-ken
|= fex=(list carp)
^+ ken.yoke
%+ roll fex
|= [=carp ken=_ken.yoke]
?+ carp ken
[%pass * %arvo %a %keen spar=*] (~(put ju ken) [spar.q p]:carp)
[%pass * %arvo %a %yawn spar=*] (~(del ju ken) [spar.q p]:carp)
==
:: +ap-handle-kicks: handle cancels of bitt.watches
::
++ ap-handle-kicks
@ -1875,10 +1913,36 @@
=? old ?=(%9 -.old) (spore-9-to-10 old)
=? old ?=(%10 -.old) (spore-10-to-11 old)
=? old ?=(%11 -.old) (spore-11-to-12 old)
?> ?=(%12 -.old)
=? old ?=(%12 -.old) (spore-12-to-13 old)
?> ?=(%13 -.old)
gall-payload(state old)
::
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11)
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11 spore-12)
+$ 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))
=bug
==
+$ egg-12
$% [%nuke sky=(map spur @ud)]
$: %live
control-duct=duct
run-nonce=@t
sub-nonce=@
=stats
=bitt
=boat
=boar
code=~
old-state=[%| vase]
=beak
marks=(map duct mark)
sky=(map spur path-state)
== ==
+$ spore-11
$: %11
system-duct=duct
@ -2010,20 +2074,6 @@
%+ murn ~(tap to q)
|=(r=remote-request-9 ?:(?=(%cork r) ~ `r))
::
:: added sky
::
++ spore-11-to-12
|= old=spore-11
^- spore
%= old
- %12
eggs
%- ~(urn by eggs.old)
|= [a=term e=egg-11]
^- egg
live/e(marks [marks.e sky:*$>(%live egg)])
==
::
:: removed live
:: changed old-state from (each vase vase) to [%| vase]
:: added code
@ -2039,6 +2089,35 @@
^- egg-11
e(|3 |4.e(|4 `|8.e(old-state [%| p.old-state.e])))
==
::
:: added sky
::
++ spore-11-to-12
|= old=spore-11
^- spore-12
%= old
- %12
eggs
%- ~(urn by eggs.old)
|= [a=term e=egg-11]
^- egg-12
live/e(marks [marks.e sky:*$>(%live egg)])
==
::
:: added ken
::
++ spore-12-to-13
|= old=spore-12
^- spore
%= old
- %13
eggs
%- ~(urn by eggs.old)
|= [a=term e=egg-12]
^- egg
?: ?=(%nuke -.e) e
e(sky [sky.e ken:*$>(%live egg)])
==
--
:: +scry: standard scry
::

12
pkg/arvo/sys/vane/jael.hoon
View File

@ -336,7 +336,7 @@
=. pos.zim.pki
%+ ~(put by pos.zim.pki)
our
[rift=1 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
[rift=0 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
:: our private key
::
:: Private key updates are disallowed for fake ships,
@ -825,7 +825,7 @@
%+ turn passes
|= [who=ship =pass]
^- [who=ship =point]
[who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
[who [rift=0 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
=. moz [[hen %give %public-keys %full (my points)] moz]
..feel
--
@ -1140,10 +1140,10 @@
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have rift=1
:: fake ships always have rift=0
::
?: fak.own.pki.lex
``[%atom !>(1)]
``[%atom !>(0)]
=/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ~
``[%atom !>(rift.u.pos)]
@ -1154,10 +1154,10 @@
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have rift=1
:: fake ships always have rift=0
::
?: fak.own.pki.lex
``[%noun !>((some 1))]
``[%noun !>((some 0))]
=/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ``[%noun !>(~)]
``[%noun !>((some rift.u.pos))]

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

@ -5593,288 +5593,6 @@
$(pops [oldest pops])
--
--
::
++ deq
|* val=mold
|%
::
:: +| %utilities
::
++ make-afx
|= ls=(list val)
?+ ls ~|(bad-finger/(lent ls) !!)
[* ~] [%1 ls]
[* * ~] [%2 ls]
[* * * ~] [%3 ls]
[* * * * ~] [%4 ls]
==
::
++ wyt
|= a=(pha val)
^- @ud
?- -.a
%nul 0
%one 1
%big :(add (lent +.p.a) (lent +.r.a) $(a q.a))
==
::
++ afx-to-pha
|= =(afx val)
^- (pha val)
(apl *(pha val) +.afx)
::
:: +| %left-biased-operations
::
:: +pop-left: remove leftmost value from tree
::
++ pop-left
|= a=(pha val)
^- [val=(unit val) pha=(pha val)]
?- -.a
%nul ~^a
::
%one [`p.a nul/~]
::
%big
[`p.p.a (big-left +.+.p.a q.a r.a)]
==
::
:: +peek-left: inspect leftmost value
::
++ peek-left
|= a=(pha val)
^- (unit val)
?- -.a
%nul ~
%one `p.a
%big `p.p.a
==
::
++ apl
|= [a=(pha val) vals=(list val)]
^- (pha val)
=. vals (flop vals)
|-
?~ vals a
$(a (cons a i.vals), vals t.vals)
::
::
++ dip-left
|* state=mold
|= $: a=(pha val)
=state
f=$-([state val] [(unit val) ? state])
==
^+ [state a]
=/ acc [stop=`?`%.n state=state]
=| new=(pha val)
|-
?: stop.acc
:: cat new and old
[state.acc (weld a new)]
=^ val=(unit val) a
(pop-left a)
?~ val
[state.acc new]
=^ res=(unit ^val) acc
(f state.acc u.val)
?~ res $
$(new (snoc new u.res))
::
++ big-left
|= [ls=(list val) a=(pha val) sf=(afx val)]
^- (pha val)
?. =(~ ls)
[%big (make-afx ls) a sf]
=/ [val=(unit val) inner=_a]
(pop-left a)
?~ val
(afx-to-pha sf)
[%big [%1 u.val ~] inner sf]
::
++ cons
=| b=(list val)
|= [a=(pha val) c=val]
^- (pha val)
=. b [c b]
|-
?~ b a
?- -.a
::
%nul
$(a [%one i.b], b t.b)
::
%one
%= $
b t.b
a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]]
==
::
%big
?. ?=(%4 -.p.a)
%= $
b t.b
::
a
?- -.p.a
%1 big/[[%2 i.b p.p.a ~] q.a r.a]
%2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a]
%3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a]
==
==
=/ inner
$(a q.a, b ~[s.p.a r.p.a q.p.a])
=. inner
$(a inner, b t.b)
big/[[%2 i.b p.p.a ~] inner r.a]
==
::
:: +| %right-biased-operations
::
:: +snoc: append to end (right) of tree
::
++ snoc
|= [a=(pha val) b=val]
^+ a
?- -.a
%nul [%one b]
::
%one
:- %big
:* [%1 p.a ~]
[%nul ~]
[%1 b ~]
==
::
%big
?- -.r.a
::
%1
:- %big
[p.a q.a [%2 p.r.a b ~]]
::
%2
:- %big
[p.a q.a [%3 p.r.a q.r.a b ~]]
::
%3
:- %big
[p.a q.a [%4 p.r.a q.r.a r.r.a b ~]]
::
%4
=/ inner
$(a q.a, b p.r.a)
=. inner
$(a inner, b q.r.a)
=. inner
$(a inner, b r.r.a)
:- %big
:* p.a
inner
[%2 s.r.a b ~]
==
==
==
:: +apr: append list to end (right) of tree
::
++ apr
|= [a=(pha val) vals=(list val)]
^- (pha val)
?~ vals a
$(a (snoc a i.vals), vals t.vals)
::
:: +big-right: construct a tree, automatically balancing the right
:: side
++ big-right
|= [pf=(afx val) a=(pha val) ls=(list val)]
^- (pha val)
?. =(~ ls)
[%big pf a (make-afx ls)]
=/ [val=(unit val) inner=_a]
(pop-right a)
?~ val
(afx-to-pha pf)
[%big pf inner [%1 u.val ~]]
::
:: +pop-right: remove rightmost value from tree
::
++ pop-right
|= a=(pha val)
^- [val=(unit val) pha=(pha val)]
?- -.a
%nul ~^a
::
%one [`p.a nul/~]
::
%big
=/ ls=(list val) +.r.a
=^ item ls (flop ls)
[`item (big-right p.a q.a (flop ls))]
==
::
++ peek-right
|= a=(pha val)
?- -.a
%nul ~
%one `p.a
%big (rear +.r.a)
==
::
:: +| %manipulation
::
:: +weld: concatenate two trees
::
:: O(log n)
++ weld
=| c=(list val)
|= [a=(pha val) b=(pha val)]
^- (pha val)
?- -.b
%nul (apr a c)
%one (snoc (apr a c) p.b)
::
%big
?- -.a
%nul (apl b c)
%one (cons (apl b c) p.a)
::
%big
:- %big
=- [p.a - r.b]
$(a q.a, b q.b, c :(welp +.r.a c +.p.b))
==
==
:: +tap: transform tree to list
::
++ tap
=| res=(list val)
|= a=(pha val)
!.
|^ ^+ res
?- -.a
%nul ~
%one ~[p.a]
::
%big
=/ fst=_res
(tap-afx p.a)
=/ lst=_res
(tap-afx r.a)
=/ mid=_res
$(a q.a)
:(welp fst mid lst)
==
++ tap-afx
|= ax=(afx val)
^+ res
?- -.ax
%1 +.ax
%2 +.ax
%3 +.ax
%4 +.ax
==
--
--
:: ::
:::: ++userlib :: (2u) non-vane utils
:: ::::

21
pkg/arvo/ted/keen.hoon
View File

@ -6,19 +6,20 @@
=/ m (strand ,vase)
^- form:m
=+ !<([~ =spar:ames] arg)
;< dat=(unit roar:ames) bind:m
(keen:strandio spar)
?~ dat
;< ~ bind:m
(keen:strandio /keen spar)
;< [* roar=(unit roar:ames)] bind:m
(take-tune:strandio /keen)
?~ roar
(pure:m !>(~))
?~ data=q.dat.u.roar
(pure:m !>(~))
::
;< =bowl:spider bind:m get-bowl:strandio
=/ [=path data=(unit (cask))] dat.u.dat
?~ data
(pure:m !>(~))
=+ .^ =dais:clay %cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.data]
==
=/ res (mule |.((vale.dais q.u.data)))
?: ?=(%| -.res)
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
(pure:m p.res)
?. ?=(%| -.res)
(pure:m p.res)
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))

2
pkg/base-dev/lib/server.hoon
View File

@ -114,7 +114,7 @@
:_ `octs
[200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]]
::
++ ico-response
++ ico-response
|= =octs
^- simple-payload:http
[[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs]

25
pkg/base-dev/lib/strandio.hoon
View File

@ -82,8 +82,6 @@
`[%done q.cage.u.in.tin]
==
::
::
::
++ take-sign-arvo
=/ m (strand ,[wire sign-arvo])
^- form:m
@ -184,21 +182,20 @@
`[%done ~]
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
==
::
++ take-tune
|= =wire
=/ m (strand ,~)
=/ m (strand ,[spar:ames (unit roar:ames)])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %poke-ack *]
::
[~ %sign * %ames %tune ^ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
?~ p.sign.u.in.tin
`[%done ~]
`[%fail %poke-fail u.p.sign.u.in.tin]
`[%done +>.sign-arvo.u.in.tin]
==
::
++ take-poke-ack
|= =wire
@ -335,14 +332,10 @@
(take-wake `until)
::
++ keen
|= =spar:ames
=/ m (strand ,(unit roar:ames))
|= [=wire =spar:ames]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass /keen %arvo %a %keen spar]
;< ~ bind:m (send-raw-card card)
;< [wire sign=sign-arvo] bind:m take-sign-arvo
?> ?=([%ames %tune *] sign)
(pure:m roar.sign)
(send-raw-card %pass wire %arvo %a %keen spar)
::
++ sleep
|= for=@dr

2
pkg/base-dev/mar/json.hoon
View File

@ -17,7 +17,7 @@
--
++ grab
|% :: convert from
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de:json) *^json))
++ mime |=([p=mite q=octs] (fall (de:json (@t q.q)) *^json))
++ noun ^json :: clam from %noun
++ numb numb:enjs
++ time time:enjs

54
pkg/base-dev/sur/hood.hoon
View File

@ -1,3 +1,4 @@
/% kelvin %kelvin
=, clay
=* dude dude:gall
|%
@ -16,6 +17,12 @@
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +truncate-hash: get last 5 digits of hash and convert to tape
::
++ truncate-hash
|= hash=@uv
^- tape
(slag 2 <`@uv`(mod hash 0v1.00000)>)
:: +report-prep: get data required for reports
::
++ report-prep
@ -33,14 +40,19 @@
::
++ report-vats
|= [our=@p now=@da desks=(list desk) filt=@tas verb=?]
^- tang
=/ ego (scot %p our)
=/ wen (scot %da now)
=/ prep (report-prep our now)
?~ filt
%- zing
%+ turn (flop desks)
|=(syd=@tas (report-vat prep our now syd verb))
=/ deks
?~ desks ~(tap in -.prep)
?~ desks
%+ sort
(sort ~(tap in -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
|=([[a=@ *] [b=@ *]] ?|(=(a %kids) =(b %base)))
%+ skip ~(tap in -.prep)
|=([syd=@tas *] =(~ (find ~[syd] desks)))
?: =(filt %blocking)
@ -57,14 +69,17 @@
|=([syd=desk *] syd)
?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"]
:- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
%- zing
%+ turn (flop blockers)
|=(syd=desk (report-vat prep our now syd verb))
::
%- zing
%+ turn
?+ filt !!
::
%exists
%+ skip deks
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
%exists
%+ skip deks
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
::
%running
%+ skim deks
@ -91,6 +106,15 @@
==
our=ship now=@da syd=desk verb=?
==
^- tang
=- :: hack to force wrapped rendering
::
:: edg=6 empirically prevents dedent
::
%+ roll
(~(win re -) [0 6])
|=([a=tape b=(list @t)] [(crip a) b])
::
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
@ -118,9 +142,6 @@
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd)
=/ =dome (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
=/ sat
?- zest.dek
%live "running"
@ -138,20 +159,29 @@
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
?. verb
=/ base-hash ?.(=(1 (lent meb)) <meb> <(head meb)>)
=/ cut=(list tape) (turn meb truncate-hash)
=/ len (lent cut)
=/ base-hash
?: =(0 len) "~"
?: =(1 len) (head cut)
"~[{`tape`(zing (join " " `(list tape)`cut))}]"
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash ends in: {(slag (sub (lent base-hash) 5) base-hash)}"
leaf/"%cz hash ends in: {(slag (sub (lent <hash>) 5) <hash>)}"
leaf/"base hash ends in: {base-hash}"
leaf/"%cz hash ends in: {(truncate-hash hash)}"
leaf/"app status: {sat}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
::
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
=/ =dome (~(got by cone) our syd)
(skid ~(tap by ren.dome) |=([* ?] +<+))
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
::
leaf/"app status: {sat}"
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
leaf/"force on: {<(sort (turn on head) aor)>}"
leaf/"force off: {<(sort (turn of head) aor)>}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"

2
pkg/landscape/app/dm-hook.hoon
View File

@ -41,7 +41,7 @@
:_ this
:_ ~
=/ dms=(list resource)
?. .^(? %gu (scry:io %graph-store ~))
?. .^(? %gu (scry:io %graph-store /$))
~
%+ skim ~(tap in get-keys:gra)
|=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag))))

4
pkg/landscape/sys.kelvin
View File

@ -1,3 +1 @@
[%zuse 416]
[%zuse 415]
[%zuse 414]
[%zuse 413]

98
tests/sys/lull/deq.hoon
View File

@ -1,98 +0,0 @@
/+ *test
=/ big-num
100
=/ de (deq ,@)
=/ big-list
(gulf 1 big-num)
=/ big
(apl:de *(pha @) big-list)
=/ foo-list (gulf 1 8)
|%
++ foo
(apl:de *(pha @) 1 2 3 4 5 6 7 8 ~)
++ bar
`(pha @)`(apl:de *(pha @) 8 9 10 11 12 13 14 15 ~)
::
++ test-tap
=/ ls
~> %bout.[1 %tap]
(tap:de big)
(expect-eq !>(ls) !>(big-list))
::
++ test-wyt
=/ le
~> %bout.[1 %wyt]
(wyt:de big)
(expect-eq !>(le) !>(big-num))
::
++ test-left
^- tang
=/ bar
~> %bout.[1 %cons]
(cons:de bar 7)
=. bar
~> %bout.[1 %apl]
(apl:de bar 1 2 3 4 5 6 ~)
%- zing
:-
~> %bout.[1 %eq-1]
(expect-eq !>((tap:de bar)) !>((gulf 1 15)))
=^ val=(unit @) bar
~> %bout.[1 %pop-left]
(pop-left:de bar)
~> %bout.[1 %eq-2]
:~ (expect-eq !>(1) !>((need val)))
(expect-eq !>((gulf 2 15)) !>((tap:de bar)))
==
::
++ test-cons-tree
=/ foo
(cons:de foo 1)
~
::
++ test-cons-list
=/ big-list
[1 big-list]
~
::
++ test-rear-tree
=/ big big
=/ res (peek-right:de big)
~
::
++ test-rear-list
=/ last (rear big-list)
~
::
++ test-right
^- tang
=/ foo
~> %bout.[1 %snoc]
(snoc:de foo 9)
=. foo
(apr:de foo 10 11 12 13 14 15 ~)
%- zing
:- (expect-eq !>((tap:de foo)) !>((gulf 1 15)))
=^ val=(unit @) foo
(pop-right:de foo)
:~ (expect-eq !>((need val)) !>(15))
(expect-eq !>((gulf 1 14)) !>((tap:de foo)))
==
++ test-queue
^- tang
=/ foo foo
=. foo
(apr:de foo 9 10 11 12 13 14 15 ~)
=/ expected (gulf 1 15)
%- zing
|- ^- (list tang)
=^ val=(unit @) foo
(pop-left:de foo)
?~ val
(expect-eq !>(~) !>(expected))^~
~& got/u.val
?~ expected
~[leaf/"queue mismatch"]
:- (expect-eq !>(i.expected) !>(u.val))
$(expected t.expected)
--