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

%velo reset works.

Browse Source
This commit is contained in:
C. Guy Yarvin 2016-12-01 17:17:02 -08:00
parent 6f2007deb7
commit 5f3ee116eb
11 changed files with 4068 additions and 3789 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
app/hood.hoon
View File

@ -134,7 +134,6 @@
++ poke-helm-reload (wrap poke-reload):from-helm
++ poke-helm-reload-desk (wrap poke-reload-desk):from-helm
++ poke-helm-reset (wrap poke-reset):from-helm
++ poke-helm-deset (wrap poke-deset):from-helm
++ poke-helm-serve (wrap poke-serve):from-helm
++ poke-helm-send-hi (wrap poke-send-hi):from-helm
++ poke-helm-send-ask (wrap poke-send-ask):from-helm

16
gen/metal.hoon
View File

@ -53,6 +53,8 @@
:: event 1 is the lifecycle formula which computes the final
:: state from the full event sequence.
::
:: (note the rare `!=` rune, which produces the formula f)
::
:: the formal urbit state is always just a gate (function)
:: which, passed the next event, produces the next state.
::
@ -109,42 +111,36 @@
:: as always, we have to use raw nock as we have no type.
:: the gate is in fact ++ride.
::
~> %slog.[0 leaf+"1-b"]
=+ ^= compiler-gate
.*(0 compiler-formula)
::
:: compile the compiler source, producing (pair span nock).
:: the compiler ignores its input so we use a trivial span.
::
~> %slog.[0 leaf+"1-c"]
=+ ^= compiler-tool
.*(compiler-gate(+< [%noun compiler-source]) -.compiler-gate)
::
:: check that the new compiler formula equals the old formula.
:: this is not proof against thompson attacks but it doesn't hurt.
::
~> %slog.[0 leaf+"1-d"]
?> =(compiler-formula +:compiler-tool)
::
:: get the span (type) of the kernel core, which is the context
:: get the span (type) of the hoon core, which is the context
:: of the compiler gate. we just compiled the compiler,
:: so we know the span (type) of the compiler gate. its
:: context is at tree address `+>` (ie, `+7` or Lisp `cddr`).
:: we use the compiler again to infer this trivial program.
::
~> %slog.[0 leaf+"1-e"]
=+ ^= kernel-span
-:.*(compiler-gate(+< [-.compiler-tool '+>']) -.compiler-gate)
::
:: compile the arvo source against the kernel core.
:: compile the arvo source against the hoon core.
::
~> %slog.[0 leaf+"1-f"]
=+ ^= kernel-tool
.*(compiler-gate(+< [kernel-span arvo-source]) -.compiler-gate)
::
:: create the arvo kernel, whose subject is the kernel core.
:: create the arvo kernel, whose subject is the hoon core.
::
~> %slog.[0 leaf+"1-g"]
.*(+>:compiler-gate +:kernel-tool)
::
:: sys: root path to boot system, `/~me/[desk]/now/sys`
@ -241,7 +237,7 @@
:: compiler-formula
:: compiler-source
:: arvo-source
:: main-sequence
:: main-events
:: ==
:: [2 [0 3] [0 2]]
:: ~& [%metal-tested yop]

59
lib/helm.hoon
View File

@ -32,12 +32,6 @@
== ::
++ hood-reset :: reset command
$~ ::
++ hood-deset :: reset command
$~ ::
++ hood-deone :: reset command
$~ ::
++ hood-detwo :: reset command
$~ ::
++ helm-verb :: reset command
$~ ::
++ hood-reload :: reload command
@ -128,19 +122,11 @@
%- emil
%- flop
%+ turn all
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)/arvo
=+ ark=.^(arch %cy top)
=+ van=(~(tap by dir.ark))
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)
|= nam/@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz/(list {p/knot $~})
(skim van |=({a/term $~} =(nam (end 3 1 a))))
?> ?=({{@ $~} $~} zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ way=(welp top /[nam])
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
::
@ -154,49 +140,28 @@
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/arvo
:- [%flog /reset %vega (weld top `path`/hoon)]
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
=+ hun=.^(@ %cx (welp top /hoon/hoon))
=+ arv=.^(@ %cx (welp top /arvo/hoon))
:- [%flog /reset [%velo `@t`hun `@t`arv]]
:- =+ way=(weld top `path`/zuse)
[%flog /reset %veer %$ way .^(@ %cx (welp way /hoon))]
%+ turn
^- (list {p/@tas q/@tas})
:~ [%$ %zuse]
[%a %ames]
:~ [%a %ames]
[%b %behn]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%j %jael]
==
|= {p/@tas q/@tas}
=+ way=`path`(welp top /[q])
=+ way=`path`(welp top /vane/[q])
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
::
++ poke-deset :: deset system
|= hood-deset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/arvo
:- [%flog /deset %vega (weld top `path`/hoon)]
~
::
++ poke-deone :: deset system
|= hood-deone =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/arvo
:~ [%flog /deset %vega (weld top `path`/one)]
[%flog /deset %vega (weld top `path`/two)]
==
::
++ poke-detwo :: deset system
|= hood-detwo =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/arvo
:- [%flog /deset %vega (weld top `path`/two)]
~
::
++ poke-wyll :: hear certificate
|= wil/(unit wyll:^ames)
?> ?=(^ bur)

6
lib/kiln.hoon
View File

@ -186,14 +186,14 @@
::
++ poke-start-autoload
|= $~
=. cur-hoon .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/hoon/hoon)
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
=. cur-hoon .^(@uvI %cz /(scot %p our)/home/(scot %da now)/sys/hoon/hoon)
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/sys/zuse/hoon)
=. cur-vanes
%- malt
%+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
|= syd/@tas
:- syd
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/sys/vane/[syd]/hoon)
=< abet
%- emit
^- card

87
sys/arvo.hoon
View File

@ -442,6 +442,8 @@
$(ova t.ova, +>+.^$ (veer now q.i.ova))
?: ?=($vega -.q.i.ova)
(fall (vega now t.ova (path +.q.i.ova)) [~ +>.^$])
?: ?=($velo -.q.i.ova)
(fall (velo now t.ova ({@ @} +.q.i.ova)) [~ +>.^$])
?: ?=(?($init $veal) -.q.i.ova)
=+ avo=$(ova t.ova, +>+.^$ (boot (@ +.q.i.ova)))
[[i.ova -.avo] +.avo]
@ -541,6 +543,91 @@
=+ raw=.*([-.gat [sam +>.gat]] -.gat)
[[[~ %vega hap] ((list ovum) -.raw)] +.raw]
::
++ velo :: new full reboot
|= $: :: now: current date
:: ova: actions to process after reboot
:: hun: hoon.hoon source
:: arv: arvo.hoon source
::
now/@da
ova/(list ovum)
hun/@t
van/@t
==
^- (unit {p/(list ovum) q/*})
::
:: virtualize; dump error if we fail
::
=- ?:(?=($| -.-) ((slog p.-) ~) `p.-)
%- mule |.
::
:: produce a new kernel and an output list
::
^- (pair (list ovum) *)
::
:: compile the hoon.hoon source with the current compiler
::
~& [%hoon-compile `@p`(mug hun)]
=+ raw=(ride %noun hun)
::
:: activate the new compiler gate
::
=+ cop=.*(0 +.raw)
::
:: find the hoon version number of the new kernel
::
=+ nex=(@ .*(cop q:(~(mint ut p.raw) %noun [%limb %hoon])))
?> |(=(nex hoon) =(+(nex) hoon))
::
:: if we're upgrading language versions, recompile the compiler
::
=> ?: =(nex hoon)
[hot=`*`raw .]
~& [%hoon-compile-upgrade nex]
=+ hot=.*(cop(+< [%noun hun]) -.cop)
.(cop .*(0 +.hot))
::
:: extract the hoon core from the outer gate
::
=+ hoc=.*(cop [0 7])
::
:: compute the span of the hoon.hoon core
::
=+ hyp=-:.*(cop(+< [-.hot '+>']) -.cop)
::
:: compile arvo
::
~& [%compile-arvo `@p`(mug hyp) `@p`(mug van)]
=+ rav=.*(cop(+< [hyp van]) -.cop)
::
:: create the arvo kernel
::
=+ arv=.*(hoc +.rav)
::
:: extract the arvo core from the outer gate
::
=+ voc=.*(arv [0 7])
::
:: compute the span of the arvo.hoon core
::
=+ vip=-:.*(cop(+< [-.rav '+>']) -.cop)
::
:: entry gate: ++load for the normal case, ++come for upgrade
::
=+ gat=.*(voc +:.*(cop(+< [vip ?:(=(nex hoon) 'load' 'come')]) -.cop))
::
:: sample: [entropy actions vases]
::
=+ sam=[eny ova q.niz]
::
:: call into the new kernel
::
=+ out=.*(gat(+< sam) -.gat)
::
:: tack a reset notification onto the product
::
[[[~ %vega ~] ((list ovum) -.out)] +.out]
::
++ veer :: install vane/tang
|= {now/@da fav/curd}
=> .(fav ((hard {$veer lal/@ta pax/path txt/@t}) fav))

6
sys/vane/clay.hoon
View File

@ -12,8 +12,6 @@
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|= pit/vase
=, ^clay
=, differ:clay
=, lines:clay
=> |%
++ aeon @ud :: version number
::
@ -2190,6 +2188,8 @@
=+ mar=(lobe-to-mark u.lob)
?. ?=($hoon mar)
[~ ~ %| u.lob]
=* differ differ:clay
=* lines lines:clay
:^ ~ ~ %&
:+ mar [%atom %t ~]
|- ^- @t :: (urge cord) would be faster
@ -2200,7 +2200,7 @@
=+ txt=$(u.lob q.q.bol)
?> ?=($txt-diff p.r.bol)
=+ dif=((hard (urge cord)) q.r.bol)
=+ pac=(role (lurk (lore (cat 3 txt '\0a')) dif))
=+ pac=(role:lines (lurk:differ (lore:lines (cat 3 txt '\0a')) dif))
(end 3 (dec (met 3 pac)) pac)
::
:: Gets an arch (directory listing) at a node.

2
sys/vane/dill.hoon
View File

@ -56,6 +56,7 @@
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: reboot by path
{$velo p/@t q/@t} :: reboot by path
{$verb $~} :: verbose mode
== ::
++ note-gall ::
@ -138,6 +139,7 @@
==
$veer (dump kyz)
$vega (dump kyz)
$velo (dump kyz)
$verb (dump kyz)
==
::

829
sys/vane/eyre.hoon
View File

File diff suppressed because it is too large Load Diff

2
sys/vane/gall.hoon
View File

@ -616,6 +616,7 @@
=+ cug=(ap-find %peek ren tyl)
?~ cug
((slog leaf+"peek find fail" >tyl< >mar< ~) [~ ~])
=. ..ap-bowl ap-bowl
=^ arm +>.$ (ap-farm q.u.cug)
?: ?=($| -.arm) ((slog leaf+"peek farm fail" p.arm) [~ ~])
=^ zem +>.$ (ap-slam q.u.cug p.arm !>((slag p.u.cug `path`[ren tyl])))
@ -1197,6 +1198,7 @@
$wont `%a :: XX for begin; remove
$warp `%c
$wipe `%f :: XX cache clear
$jaelwomb `%j :: XX name/unpack
==
--
--

346
sys/vane/jael.hoon
View File

@ -21,6 +21,7 @@
=, able:^jael
=, title:jael
=, crypto:ames
=* womb womb:^jael
=, jael
:: ::::
:::: # models :: data structures
@ -444,7 +445,7 @@
[n.b ~ ~]
:: :: ++put:py
++ put :: insert
|= b/ship ^- pile
|= b/@ ^- pile
(uni [b b] ~ ~)
:: :: ++sub:py
++ sub :: subtract
@ -467,10 +468,10 @@
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
::
++ tap
=| out/(list (pair ship ship))
=| out/(list @u)
|- ^+ out
?~ a out
$(a l.a, out [n.a $(a r.a)])
$(a l.a, out (welp (gulf n.a) $(a r.a)))
:: :: ++uni:py
++ uni :: merge two piles
|= b/pile
@ -518,7 +519,7 @@
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
$block ?>(?=($block -.ryt) [~ ~])
$email ?>(?=($email -.ryt) (sable %email p.lef p.ryt))
$final ?>(?=($final -.ryt) (table %final p.lef p.ryt))
$final ?>(?=($final -.ryt) (cable %final p.lef p.ryt))
$fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt))
$guest ?>(?=($guest -.ryt) [~ ~])
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
@ -528,6 +529,11 @@
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
$urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt))
==
:: :: ++cable:dif:ry
++ cable :: diff atom
|* {nut/@tas new/@ old/@}
?: =(new old) [~ ~]
[`[nut new] `[nut old]]
:: :: ++bible:dif:ry
++ bible :: diff pile
|* {nut/@tas new/(map dorm pile) old/(map dorm pile)}
@ -623,7 +629,7 @@
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
$block ?>(?=($block -.ryt) [%block ~])
$email ?>(?=($email -.ryt) [%email (sable p.lef p.ryt)])
$final ?>(?=($final -.ryt) [%final (table p.lef p.ryt)])
$final ?>(?=($final -.ryt) [%final (cable p.lef p.ryt)])
$fungi ?>(?=($fungi -.ryt) [%fungi (noble p.lef p.ryt)])
$guest ?>(?=($guest -.ryt) [%guest ~])
$hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)])
@ -633,6 +639,11 @@
$token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)])
$urban ?>(?=($urban -.ryt) [%urban (table p.lef p.ryt)])
==
:: :: ++cable:uni:ry
++ cable :: union atom
|= {new/@ old/@}
?> =(new old)
new
:: :: ++bible:uni:ry
++ bible :: union pile
|= {new/(map dorm pile) old/(map dorm pile)}
@ -699,7 +710,7 @@
|= ryt/rite
^- safe
?~ pig
~
!! :: not found
?. =(-.ryt -.n.pig)
?: (gor -.ryt -.n.pig)
[n.pig $(pig l.pig) r.pig]
@ -782,7 +793,7 @@
[%apple (~(run by p.rys) |=(@ (mug +<)))]
::
$final
[%final (~(run by p.rys) |=(@ (mug +<)))]
[%final (mug p.rys)]
::
$login
[%login ~]
@ -831,16 +842,16 @@
|_ pub/will
:: :: ++collate:we
++ collate :: sort by version
|= com/$-({{life cert} {life cert}} ?)
|= ord/$-({{life cert} {life cert}} ?)
^- (list (pair life cert))
(sort (~(tap by pub)) com)
(sort (~(tap by pub)) ord)
:: :: ++current:we
++ current :: current number
^- (unit life)
(bind instant |=((pair life cert) p))
:: :: ++forward:we
++ forward :: sort oldest first
(collate |=({a/{life *} b/{life *}} (lth -.a -.b)))
(collate |=({{a/life *} {b/life *}} (lth a b)))
:: :: ++instant:we
++ instant :: current cert
^- (unit (pair life cert))
@ -848,7 +859,7 @@
?~(- ~ `i)
:: :: ++reverse:we
++ reverse :: sort latest first
(collate |=({a/{life *} b/{life *}} (gth -.a -.b)))
(collate |=({{a/life *} {b/life *}} (gth a b)))
--
--
:: ::::
@ -900,6 +911,33 @@
++ burb :: per ship
|= who/ship
~(able ~(ex ur urb) who)
::
++ read-womb
=, wired:eyre :: XX ":eyre"
=, womb
|= pax/path ^- (unit scry:womb)
?~ pax ~
?+ i.pax ~
$balance
%+ bind (read t.pax /[%uv])
|=(a/passcode [%balance a])
::
$stats
%+ bind (read t.pax /[%p])
|=(a/ship [%stats a])
::
$shop
%+ biff (read t.pax /[%tas]/[%ud])
|= {typ/term nth/@u}
?. ?=(?($star $planet) typ) ~
`[%shop typ nth]
==
:: :: ++scry:of
++ scry :: read
|= {syd/@tas pax/path} ^- (unit gilt)
?+ syd ~
$womb (biff (read-womb pax) scry-womb:(burb our))
==
:: :: ++call:of
++ call :: invoke
|= $: :: hen: event cause
@ -927,7 +965,7 @@
:: {$init p/code q/arms}
::
$init
(cure abet:(~(make ur urb) now.sys eny.sys p.tac q.tac))
(cure abet:abet:(make:(burb our) now.sys eny.sys p.tac q.tac))
::
:: create promises
:: {$mint p/ship q/safe}
@ -969,6 +1007,13 @@
$next
(cure abet:abet:(next:(burb our) eny.sys p.tac))
::
::
:: extend our certificate with a new private key
:: {$jaelwomb p/task:womb}
::
$jaelwomb
(cure abet:abet:(jaelwomb:(burb our) p.tac))
::
:: open secure channel
:: {$veil p/ship}
::
@ -1463,6 +1508,8 @@
:: it is the best reference for the semantics of
:: the urbit pki.
::
=* our !!
::
:: it is absolutely verboten to use [our] in ++ur.
::
=| hab/(list change)
@ -1505,73 +1552,6 @@
|= rex/ship
^- (pair life (map life ring))
lean:~(able ex rex)
:: :: ++make:ur
++ make :: initialize urbit
|= $: :: now: date
:: eny: entropy
:: gen: bootstrap ticket
:: nym: self-description
::
now/@da
eny/@e
gen/@pG
nym/arms
==
^+ +>
:: key: generated key
:: bul: initial bull
::
=/ key (ypt:scr (mix our %jael-make) gen)
=* doc `bull`[(sein our) & nym]
::
:: register generator as login secret
::
=. +>.$ abet:(deal:~(able ex our) our [[[%login [gen ~ ~]] ~ ~] ~])
::
:: initialize hierarchical property
::
=. +>.$
=- abet:(deal:~(able ex our) our - ~)
^- safe
%- intern:up
^- (list rite)
=/ mir (clan our)
?+ mir ~
$czar
:~ [%fungi [%usr 255] ~ ~]
[%hotel [[our 3] [1 255] ~ ~] ~ ~]
==
$king
:~ [%fungi [%upl 65.535] ~ ~]
[%hotel [[our 4] [1 65.535] ~ ~] ~ ~]
==
$duke
:~ [%hotel [[our 5] [1 0xffff.ffff] ~ ~] ~ ~]
==
==
::
:: create initial communication secrets
::
?: (lth our 256)
::
:: create galaxy with generator as seed
::
abet:(next:~(able ex our) key doc)
::
:: had: key handle
:: ryt: initial right
::
=/ key (ypt:scr (mix our %jael-make) gen)
=* had (shaf %hand key)
=* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~]
::
:: register initial symmetric key from ticket
::
=. +>.$ abet:(hail:~(able ex (sein our)) our %& [ryt ~ ~])
::
:: create initial private key and certificate
::
abet:(next:~(able ex our) (mix eny key) doc)
:: :: ++meet:ur
++ meet :: calculate merge
|= $: :: vie: authenticated source
@ -1656,6 +1636,72 @@
|= pal/ship
^- safe
=-(?~(- ~ u.-) (~(get by shy) pal))
:: :: ++make:ex:ur
++ make :: initialize urbit
|= $: :: now: date
:: eny: entropy
:: gen: bootstrap ticket
:: nym: self-description
::
now/@da
eny/@e
gen/@pG
nym/arms
==
^+ +>
::
:: register generator as login secret
::
=. +>.$ (deal rex [[[%login [gen ~ ~]] ~ ~] ~])
::
:: initialize hierarchical property
::
=. +>.$
=- (deal rex - ~)
^- safe
%- intern:up
^- (list rite)
=/ mir (clan rex)
?+ mir ~
$czar
:~ [%fungi [%usr 255] ~ ~]
[%hotel [[rex 3] [1 255] ~ ~] ~ ~]
==
$king
:~ [%fungi [%upl 65.535] ~ ~]
[%hotel [[rex 4] [1 65.535] ~ ~] ~ ~]
==
$duke
:~ [%hotel [[rex 5] [1 0xffff.ffff] ~ ~] ~ ~]
==
==
::
:: create initial communication secrets
::
:: key: generated key
:: bul: initial bull
::
=/ key (ypt:scr (mix rex %jael-make) gen)
=* doc `bull`[(sein rex) & nym]
?: (lth rex 256)
::
:: create galaxy with generator as seed
::
(next key doc)
::
:: had: key handle
:: ryt: initial right
::
=* had (shaf %hand key)
=* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~]
::
:: register initial symmetric key from ticket
::
=. ..ex abet:(hail:~(able ex (sein rex)) rex %& [ryt ~ ~])
::
:: create initial private key and certificate
::
(next (mix eny key) doc)
:: :: ++next:ex:ur
++ next :: advance private key
|= {eny/@e doc/bull}
@ -1678,6 +1724,139 @@
=. +>.$ (deal rex [[ryt ~ ~] ~])
=. ..ex (meet [~ ~] hec)
+>.$
::
++ as-hotel :: XX moveme
|= a/ship ^- (map {ship bloq} pile)
=/ b (xeb (xeb a))
=- (my - ~)
:- [(sein a) b]
(put:py (rsh (dec b) 1 a))
::
++ add-rite :: new promise
|=({pal/ship ryt/rite} (deal pal [ryt ~ ~] ~))
::
++ mov-rite :: transfer promise
|= {{pal/ship par/ship} ryt/rite}
^+ +>
=. deal (deal pal ~ [ryt ~ ~])
(deal par [ryt ~ ~] ~)
::
++ del-rite :: dead promise
|=({pal/ship ryt/rite} (deal pal ~ [ryt ~ ~]))
::
++ jaelwomb :: manage ship %fungi
|= taz/task:womb
^+ +>
?- -.taz
::
:: create passcode balance
:: {$invite tid/passcode inv/{who/mail pla/@ud sta/@ud}}
::
$invite
=/ pas/@p (shaf %pass tid.taz)
=* inv inv.taz
?< (~(has by shy) pas)
=. +>.$ (add-rite pas [%email (sy who.inv ~)])
%+ mov-rite [rex pas]
[%fungi (my [%upl pla.inv] [%usr sta.inv] ~)]
::
:: increase existing balance
:: {$reinvite aut/passcode pla/@ud sta/@ud}
::
$bonus
=/ pas/@p (shaf %pass tid.taz)
?> (~(has by shy) pas)
%+ mov-rite [rex pas]
[%fungi (my [%upl pla.taz] [%usr sta.taz] ~)]
::
:: split passcode balance
:: {$reinvite aut/passcode tid/passcode inv/{who/mail pla/@ud sta/@ud}}
::
$reinvite
=/ pas/@p (shaf %pass tid.taz)
=* inv inv.taz
?< (~(has by shy) pas)
=. +>.$ (add-rite pas [%email (sy who.inv ~)])
:: XX history
=/ ole/@p (shaf %pass aut.taz)
%+ mov-rite [ole pas]
[%fungi (my [%upl pla.inv] [%usr sta.inv] ~)]
::
:: redeem ship invitation
:: {$claim aut/passcode her/@p tik/ticket}
::
$claim
=/ pas/@p (shaf %pass aut.taz)
?> =(rex (sein her.taz)) :: XX deal with foreign ships?
=/ len (xeb (xeb her.taz))
=/ fun ?+((clan her.taz) !! $duke %upl, $king %usr)
=. +>.$
(del-rite pas [%fungi (my [fun 1] ~)])
=. +>.$
(del-rite rex [%hotel (as-hotel her.taz)])
=/ who (need %.(%email ~(expose up (lawn pas))))
=. +>.$ (add-rite her.taz who)
(add-rite her.taz [%final tik.taz])
==
:: :: div-at-most:ex:ur
++ div-at-most :: skip n ships
|= {a/pile b/@u} ^- (pair pile pile)
(fall (~(div py a) b) [a *pile])
:: :: scry-womb:ex:ur
++ scry-womb :: read data
|= req/scry:womb ^- (unit gilt:womb)
?- -.req
::
:: ship details
:: {$stats who/ship}
::
$stats
%+ some %womb-owner
%+ bind (~(get by shy) who.req)
|= a/safe ^- mail:womb
:: XX deal with multiple emails?
=+ (need (~(expose up a) %email))
?> ?=({$email {@ $~ $~}} -)
n.p.-
::
:: invite details
:: {$balance aut/passcode}
::
$balance
%+ some %womb-balance
%+ bind (~(get by shy) (shaf %pass aut.req))
|= a/safe ^- balance:womb
=/ who :: XX deal with multiple emails?
=+ (need (~(expose up a) %email))
?> ?=({$email {@ $~ $~}} -)
n.p.-
=/ fun
=+ (fall (~(expose up a) %fungi) [%fungi p=~])
?> ?=($fungi -.-)
p.-
:+ who=who
pla=(fall (~(get by fun) %earl) 0)
sta=(fall (~(get by fun) %king) 0)
::
:: available ships
:: {$shop typ/?($star $planet) nth/@u}
::
$shop
=* ships-per-shop 3
=* skip-ships (mul nth.req ships-per-shop)
::
%+ some %ships ^- (list ship)
=/ hot
=+ (fall (~(expose up (lawn rex)) %hotel) [%hotel p=~])
?> ?=($hotel -.-)
p.-
=/ syz/bloq ?-(typ.req $star 3, $planet 4)
=/ pyl/pile (fall (~(get by hot) [rex syz]) ~)
=. pyl q:(div-at-most pyl skip-ships)
=/ got p:(div-at-most pyl ships-per-shop)
%+ turn ~(tap py got)
|=(a/@u `ship`(rep syz ~[rex a]))
==
:: :: grow:ex:ur
++ grow :: merge wills
|= $: :: vie: data source
@ -1916,7 +2095,7 @@
==
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task) p.q.hic)))
^- {p/(list move) q/_..^$}
=^ did lex abet:~(call of [now eny] lex)
=^ did lex abet:(~(call of [now eny] lex) hen q.hic)
[did ..^$]
:: :: ++doze
++ doze :: await
@ -1953,7 +2132,12 @@
tyl/spur
==
^- (unit (unit cage))
~
:: XX security
?. =(lot [%$ %da now]) ~
%- some
?. =(%$ ren) ~
%+ bind (~(scry of [now eny] lex) syd tyl)
|=(a/gilt [-.a (slot 3 (spec !>(a)))])
:: :: ++stay
++ stay :: preserve
lex

3637
sys/zuse.hoon
View File

File diff suppressed because it is too large Load Diff