diff --git a/app/hood.hoon b/app/hood.hoon index 70ccff8167..63f912b610 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -61,7 +61,7 @@ :: ++ ably :: save part |* {(list) hood-part} - [(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))] + [(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))] :: :: :: :::: :: :: :: :: :: @@ -165,15 +165,10 @@ ++ poke-womb-obey (wrap poke-obey):from-womb ++ poke-womb-bonus (wrap poke-bonus):from-womb ++ poke-womb-claim (wrap poke-claim):from-womb -++ poke-womb-do-ticket (wrap poke-do-ticket):from-womb -++ poke-womb-do-claim (wrap poke-do-claim):from-womb ++ poke-womb-rekey (wrap poke-rekey):from-womb ++ poke-womb-report (wrap poke-report):from-womb -++ poke-womb-manage (wrap poke-manage):from-womb ++ poke-womb-recycle (wrap poke-recycle):from-womb ++ poke-womb-manage-old-key (wrap poke-manage-old-key):from-womb -++ poke-womb-release (wrap poke-release):from-womb -++ poke-womb-release-ships (wrap poke-release-ships):from-womb ++ poke-womb-reinvite (wrap poke-reinvite):from-womb ++ poke-womb-replay-log (wrap poke-replay-log):from-womb ++ poke-write-sec-atom (wrap poke-sec-atom):from-write diff --git a/arvo/ames.hoon b/arvo/ames.hoon index 1c377a6d55..aa39fb7270 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -2041,6 +2041,7 @@ :_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~])) ~& [%beer p.bon] :* [hen [%slip %c %init p.bon]] + [hen [%slip %j %init p.bon]] [hen [%give %init p.bon]] [hen [%slip %a %kick now]] [hen [%slip %e %init p.bon]] diff --git a/arvo/gall.hoon b/arvo/gall.hoon index 6f70f1614d..ffc8461d87 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -1196,6 +1196,7 @@ $wont `%a :: XX for begin; remove $warp `%c $wipe `%f :: XX cache clear + $jaelwomb `%j :: XX name/unpack == -- -- diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 8bec7aa5dd..32453a9907 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -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,9 @@ :: {$init p/code q/arms} :: $init - (cure abet:(~(make ur urb) now.sys eny.sys p.tac q.tac)) + =. our p.tac + (cure abet:abet:(make:(burb our) now.sys eny.sys (shaf %genr eny.sys) *arms)) +:: (cure abet:abet:(make:(burb our) now.sys eny.sys p.tac q.tac)) :: :: create promises :: {$mint p/ship q/safe} @@ -969,6 +1009,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 +1510,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 +1554,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 +1638,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 +1726,140 @@ =. +>.$ (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 shy] + ?- -.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 +2098,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 +2135,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 diff --git a/arvo/zuse.hoon b/arvo/zuse.hoon index f1613b949c..e57bb83888 100644 --- a/arvo/zuse.hoon +++ b/arvo/zuse.hoon @@ -922,22 +922,57 @@ %+ each balance :: complete action :: change :: - ++ task :: in request ->$ - $% {$burn p/ship q/safe} :: destroy rights - {$hail p/ship q/remote} :: remote update - {$init p/@pG q/arms} :: initialize urbit - {$meet p/(unit (unit ship)) q/farm} :: integrate pki from - {$mint p/ship q/safe} :: create rights - {$move p/ship q/ship r/safe} :: transfer from/to - {$next p/bull} :: update private key - {$nuke $~} :: cancel tracker from - {$veil p/ship} :: view secret channel - {$vein $~} :: view signing keys - {$vest $~} :: view public balance - {$vine $~} :: view secret history - {$west p/ship q/path r/*} :: remote request - == :: - -- :: moves + ++ task :: in request ->$ + $% {$burn p/ship q/safe} :: destroy rights + {$hail p/ship q/remote} :: remote update + {$init p/@p} +:: {$init p/@pG q/arms} :: initialize urbit + {$meet p/(unit (unit ship)) q/farm} :: integrate pki from + {$mint p/ship q/safe} :: create rights + {$move p/ship q/ship r/safe} :: transfer from/to + {$next p/bull} :: update private key + {$nuke $~} :: cancel tracker from + {$veil p/ship} :: view secret channel + {$vein $~} :: view signing keys + {$vest $~} :: view public balance + {$vine $~} :: view secret history + {$jaelwomb p/task:womb} + {$west p/ship q/path r/*} :: remote request + == :: + ++ gilt gilt:womb + -- + :: + ++ womb ^? + :: types used to serve the lib/womb invite controller + |% + ++ ticket @G :: old 64-bit ticket + ++ passcode @uvH :: 128-bit passcode + ++ passhash @uwH :: passocde hash + ++ mail @t :: email address + ++ invite :: + $: who/mail :: owner email + pla/@ud :: planets to send + sta/@ud :: stars to send + == :: + :: :: + ++ task :: manage ship %fungi + $% {$claim aut/passcode her/@p tik/ticket} :: convert to %final + {$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode + {$invite tid/passcode inv/invite} :: alloc to passcode + {$reinvite aut/passcode tid/passcode inv/invite}:: move to another + == + ++ scry + $% {$shop typ/?($star $planet) nth/@u} :: available ships + {$stats who/ship} :: ship details + {$balance aut/passcode} :: invite details + == + ++ balance {who/mail pla/@ud sta/@ud} :: equivalent to invite? + ++ gilt + $% {$ships (list ship)} :: + {$womb-owner (unit mail)} :: + {$womb-balance (unit balance)} :: + == + -- :: :: :::: ++pki:^jael :: (1h2) certificates :: :::: @@ -1030,8 +1065,8 @@ ++ rite :: urbit commitment $% {$apple p/(map site @)} :: web api key {$block $~} :: banned - {$email p/(set @ta)} :: email addresses - {$final p/(map ship @pG)} :: ticketed ships + {$email p/(set @t)} :: email addresses + {$final p/@pG} :: recognize by ticket {$fungi p/(map term @ud)} :: fungibles {$guest $~} :: refugee visa {$hotel p/(map dorm pile)} :: reserved block @@ -4516,6 +4551,7 @@ {$e task:able:^eyre} {$f task:able:^ford} {$g task:able:^gall} + {$j $init ship} :: XX actual jael tasks == == ++ sign-arvo :: in result $<- $% {$a gift:able:^ames} diff --git a/gen/hood/invite.hoon b/gen/hood/invite.hoon index b89f938660..582d4b5fad 100644 --- a/gen/hood/invite.hoon +++ b/gen/hood/invite.hoon @@ -8,9 +8,9 @@ /+ womb :- %say |= $: {now/@da eny/@uvJ bec/beak} - {{who/@t $~} ref/(unit (each ship mail:womb)) sta/@} + {{who/@t $~} sta/@} == :- %womb-invite -^- {cord reference invite}:womb +^- {cord invite}:womb =+ inv=(scot %uv (end 7 1 eny)) -[inv ref [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]] +[inv [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]] diff --git a/gen/solid.hoon b/gen/solid.hoon index 6938e168d8..f3445d6159 100644 --- a/gen/solid.hoon +++ b/gen/solid.hoon @@ -28,6 +28,7 @@ [%b %behn] [%d %dill] [%e %eyre] + [%j %jael] == |- ^+ all ?~ vay all diff --git a/lib/kiln.hoon b/lib/kiln.hoon index 7080cdc276..7e044625dc 100644 --- a/lib/kiln.hoon +++ b/lib/kiln.hoon @@ -192,7 +192,7 @@ =. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon) =. cur-vanes %- malt - %+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall] + %+ 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) @@ -244,7 +244,7 @@ |= {way/wire rot/riot} ?> ?=($~ way) ?> ?=(^ rot) - =+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall] + =+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael] =. +>.$ ?. autoload +>.$ diff --git a/lib/womb.hoon b/lib/womb.hoon index c788ccfa97..42d7d7f1bb 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -5,49 +5,50 @@ /+ talk, old-phon =, wired:eyre =, title:jael +=, womb:^jael :: :: :: :::: :: :: :: :: :: -|% -++ foil :: ship allocation map - |* mold :: entry mold - $: min/@u :: minimum entry - ctr/@u :: next allocated - und/(set @u) :: free under counter - ove/(set @u) :: alloc over counter - max/@u :: maximum entry - box/(map @u +<) :: entries - == :: --- :: +:: |% +:: ++ foil :: ship allocation map +:: |* mold :: entry mold +:: $: min/@u :: minimum entry +:: ctr/@u :: next allocated +:: und/(set @u) :: free under counter +:: ove/(set @u) :: alloc over counter +:: max/@u :: maximum entry +:: box/(map @u +<) :: entries +:: == :: +:: -- :: :: :: :::: :: :: :: |% :: -++ managed :: managed plot - |* mold :: - %- unit :: unsplit - %+ each +< :: subdivided - mail :: delivered -:: :: -++ divided :: get division state - |* (managed) :: - ?- +< :: - $~ ~ :: unsplit - {$~ $| *} ~ :: delivered - {$~ $& *} (some p.u.+<) :: subdivided - == :: -:: :: -++ moon (managed _!!) :: undivided moon -:: -++ planet :: subdivided planet - (managed (lone (foil moon))) :: -:: :: -++ star :: subdivided star - (managed (pair (foil moon) (foil planet))) :: -:: :: -++ galaxy :: subdivided galaxy - (managed (trel (foil moon) (foil planet) (foil star))):: -:: :: +:: ++ managed :: managed plot +:: |* mold :: +:: %- unit :: unsplit +:: %+ each +< :: subdivided +:: mail :: delivered +:: :: :: +:: ++ divided :: get division state +:: |* (managed) :: +:: ?- +< :: +:: $~ ~ :: unsplit +:: {$~ $| *} ~ :: delivered +:: {$~ $& *} (some p.u.+<) :: subdivided +:: == :: +:: :: :: +:: ++ moon (managed _!!) :: undivided moon +:: :: +:: ++ planet :: subdivided planet +:: (managed (lone (foil moon))) :: +:: :: :: +:: ++ star :: subdivided star +:: (managed (pair (foil moon) (foil planet))) :: +:: :: :: +:: ++ galaxy :: subdivided galaxy +:: (managed (trel (foil moon) (foil planet) (foil star))):: +:: :: :: ++ ticket @G :: old 64-bit ticket ++ passcode @uvH :: 128-bit passcode ++ passhash @uwH :: passocde hash @@ -58,15 +59,11 @@ owner/mail :: owner's email history/(list mail) :: transfer history == :: -++ client :: per email - $: sta/@ud :: unused star refs - has/(set @p) :: planets owned - == :: -++ property :: subdivided plots - $: galaxies/(map @p galaxy) :: galaxy - planets/(map @p planet) :: star - stars/(map @p star) :: planet - == :: +:: ++ property :: subdivided plots +:: $: galaxies/(map @p galaxy) :: galaxy +:: planets/(map @p planet) :: star +:: stars/(map @p star) :: planet +:: == :: ++ invite :: $: who/mail :: who to send to pla/@ud :: planets to send @@ -77,10 +74,6 @@ $: intro/tape :: in invite email hello/tape :: as talk message == :: -++ reference :: affiliate credit - (unit (each @p mail)) :: ship or email -:: :: -++ reference-rate 2 :: star refs per star ++ stat (pair live dist) :: external info ++ live ?($cold $seen $live) :: online status ++ dist :: allocation @@ -102,9 +95,8 @@ ++ part {$womb $1 pith} :: womb state ++ pith :: womb content $: boss/(unit ship) :: outside master - bureau/(map passhash balance) :: active invitations - office/property :: properties managed - hotel/(map (each ship mail) client) :: everyone we know +:: bureau/(map passhash balance) :: active invitations +:: office/property :: properties managed recycling/(map ship @) :: old ticket keys == :: -- :: @@ -112,6 +104,14 @@ :::: :: :: :: :: :: |% :: arvo structures +++ invite-j {who/mail pla/@ud sta/@ud} :: invite data +++ balance-j {who/mail pla/@ud sta/@ud} :: balance data +++ womb-task :: manage ship %fungi + $% {$claim aut/passcode her/@p tik/ticket} :: convert to %final + {$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode + {$invite tid/passcode inv/invite-j} :: alloc to passcode + {$reinvite aut/passcode tid/passcode inv/invite-j}:: move to another + == :: ++ card :: $% {$flog wire flog:^dill} :: {$info wire @p @tas nori:^clay} :: fs write (backup) @@ -120,7 +120,8 @@ {$poke wire dock pear} :: app RPC {$next wire p/ring} :: update private key {$tick wire p/@pG q/@p} :: save ticket - {$knew wire p/ship q/wyll:^ames} :: learn wyll (old pki) + {$knew wire p/ship q/wyll:^ames} :: learn will (old pki) + {$jaelwomb wire task:womb} :: manage rights == :: ++ pear :: $% {$email mail tape wall} :: send email @@ -133,19 +134,17 @@ {$womb-balance balance} :: {$womb-balance-all (map passhash mail)} :: {$womb-stat stat} :: - {$womb-stat-all (map ship stat)} :: +:: {$womb-stat-all (map ship stat)} :: {$womb-ticket-info passcode ?($fail $good $used)} :: == ++ move (pair bone card) :: user-level move :: ++ transaction :: logged poke $% {$report her/@p wyl/wyll:^ames} - {$release gal/@ud sta/@ud} - {$release-ships (list ship)} {$claim aut/passcode her/@p} {$recycle who/mail him/knot tik/knot} {$bonus tid/cord pla/@ud sta/@ud} - {$invite tid/cord ref/reference inv/invite} + {$invite tid/cord inv/invite} {$reinvite aut/passcode inv/invite} == -- @@ -170,86 +169,8 @@ =+ d=(b q.c) ?~(d ~ (some [p.c u.d])) :: -++ unsplit - |= a/(map ship (managed)) ^- (list {ship *}) - %+ skim (~(tap by a)) - |=({@ a/(managed)} ?=($~ a)) -:: -++ issuing - |* a/(map ship (managed)) - ^- (list {ship _(need (divided *~(got by a)))}) - (sort (~(tap by (murn-by a divided))) lor) -:: -++ issuing-under - |* {a/bloq b/ship c/(map @u (managed))} - ^- (list {ship _(need (divided *~(got by c)))}) - %+ turn (sort (~(tap by (murn-by c divided))) lor) - |*(d/{@u *} [(rep a b -.d ~) +.d]) -++ cursor (pair (unit ship) @u) ++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix :: -:: Create new foil of size -++ fo-init - |= a/bloq :: ^- (foil *) - [min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~] -:: -++ fo - |_ (foil $@($~ *)) - ++ nth :: index - |= a/@u ^- (pair (unit @u) @u) - ?: (lth a ~(wyt in und)) - =+ out=(snag a (sort (~(tap in und)) lth)) - [(some out) 0] - =. a (sub a ~(wyt in und)) - |- ^- {(unit @u) @u} - ?: =(ctr +(max)) [~ a] - ?: =(0 a) [(some ctr) a] - $(a (dec a), +<.nth new) - :: - +- fin +< :: abet - ++ new :: alloc - ?: =(ctr +(max)) +< - =. ctr +(ctr) - ?. (~(has in ove) ctr) +< - new(ove (~(del in ove) ctr)) - :: - +- get :: nullable - |= a/@p ^+ ?~(box ~ q.n.box) - (fall (~(get by box) (neis a)) ~) - :: - +- put - |* {a/@u b/*} ^+ fin :: b/_(~(got by box)) - ~| put+[a fin] - ?> (fit a) - =; adj adj(box (~(put by box) a b)) - ?: (~(has in box) a) fin - ?: =(ctr a) new - ?: (lth a ctr) - ?. (~(has in und) a) fin - fin(und (~(del in und) a)) - ?. =(a ctr:new) :: heuristic - fin(ove (~(put in ove) a)) - =+ n=new(+< new) - n(und (~(put in und.n) ctr)) - :: - ++ fit |=(a/@u &((lte min a) (lte a max))) :: in range - ++ gud :: invariant - ?& (fit(max +(max)) ctr) - (~(all in und) fit(max ctr)) - (~(all in ove) fit(min ctr)) - (~(all in box) |=({a/@u *} (fit a))) - |- ^- ? - ?: =(min max) & - =- &(- $(min +(min))) - %+ gte 1 :: at most one of - ;: add - ?:(=(min ctr) 1 0) - ?:((~(has in und) min) 1 0) - ?:((~(has in ove) min) 1 0) - ?:((~(has by box) min) 1 0) - == - == - -- -- :: :: :: :::: :: :: @@ -272,32 +193,6 @@ ^+ +> ?~(+< +> $(+< t.+<, +> (emit i.+<))) :: -:: -++ take-n :: compute range - |= {{index/@u count/@u} get/$-(@u cursor)} - ^- (list ship) - ?~ count ~ - %+ biff p:(get index) - |= a/ship ^- (list ship) - [a ^$(index +(index), count (dec count))] -:: -++ available :: enumerate free ships - |= all/(map ship (managed)) ^- $-(@u cursor) - =+ pur=(sort (turn (unsplit all) head) lth) - =+ len=(lent pur) - |=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a])) -:: -:: foil cursor to ship cursor, using sized parent -++ prefix - |= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor - ?~ c [c d] - [(some (rep a b u.c ~)) d] -:: -++ in-list :: distribute among options - |* {a/(list) b/@u} ^+ [(snag *@ a) b] - =+ c=(lent a) - [(snag (mod b c) a) (div b c)] -:: ++ ames-last-seen :: last succesful ping |= a/ship ~+ ^- (unit time) ?: =(a our) (some now) @@ -306,113 +201,25 @@ %+ ames-grab %rue .^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a)) :: -++ neighboured :: filter for connectivity - |* a/(list {ship *}) ^+ a - %+ skim a - |= {b/ship *} - ?=(^ (ames-last-seen b)) +++ jael-scry + |* {typ/mold pax/path} ^- typ + .^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax)) :: -++ shop-galaxies (available galaxies.office) :: unassigned %czar +++ jael-pas-balance + |= pas/passcode ^- (unit balance) + %+ bind (jael-scry (unit balance-j) /balance/(scot %uv pas)/womb-balance) + |= a/balance-j ^- balance + =/ hiz/(list mail) ~ :: XX track history in jael + [pla.a sta.a who.a hiz] :: -:: Stars can be either whole or children of galaxies -++ shop-stars :: unassigned %king - |= nth/@u ^- cursor - =^ out nth %.(nth (available stars.office)) - ?^ out [out nth] - %+ shop-star nth - (neighboured (issuing galaxies.office)) -:: -++ shop-star :: star from galaxies - |= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor - ?: =(~ lax) [~ nth] - =^ sel nth (in-list lax nth) - (prefix 3 who.sel (~(nth fo r.sel) nth)) -:: -++ shop-planets :: unassigned %duke - |= nth/@u ^- cursor - =^ out nth %.(nth (available planets.office)) - ?^ out [out nth] - =^ out nth - %+ shop-planet nth - (neighboured (issuing stars.office)) - ?^ out [out nth] - (shop-planet-gal nth (issuing galaxies.office)) -:: -++ shop-planet :: planet from stars - |= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor - ?: =(~ sta) [~ nth] - =^ sel nth (in-list sta nth) - (prefix 4 who.sel (~(nth fo q.sel) nth)) -:: -++ shop-planet-gal :: planet from galaxies - |= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor - ?: =(~ lax) [~ nth] - =^ sel nth (in-list lax nth) - %+ shop-planet nth - (neighboured (issuing-under 3 who.sel box.r.sel)) :: ++ peek-x-shop :: available ships |= tyl/path ^- (unit (unit {$ships (list @p)})) =; a ~& peek-x-shop+[tyl a] a - =; res (some (some [%ships res])) - =+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~)) - :: =. nth (mul 3 nth) - ?+ typ ~|(bad-type+typ !!) - $galaxies (take-n [nth 3] shop-galaxies) - $planets (take-n [nth 3] shop-planets) - $stars (take-n [nth 3] shop-stars) - == -:: -++ get-managed-galaxy ~(got by galaxies.office) :: office read -++ mod-managed-galaxy :: office write - |= {who/@p mod/$-(galaxy galaxy)} ^+ +> - =+ gal=(mod (get-managed-galaxy who)) - +>.$(galaxies.office (~(put by galaxies.office) who gal)) -:: -++ get-managed-star :: office read - |= who/@p ^- star - =+ (~(get by stars.office) who) - ?^ - u - =+ gal=(get-managed-galaxy (sein who)) - ?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!) - (fall (~(get by box.r.p.u.gal) (neis who)) ~) -:: -++ mod-managed-star :: office write - |= {who/@p mod/$-(star star)} ^+ +> - =+ sta=(mod (get-managed-star who)) :: XX double traverse - ?: (~(has by stars.office) who) - +>.$(stars.office (~(put by stars.office) who sta)) - %+ mod-managed-galaxy (sein who) - |= gal/galaxy ^- galaxy - ?> ?=({$~ $& *} gal) - gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta)) -:: -++ get-managed-planet :: office read - |= who/@p ^- planet - =+ (~(get by planets.office) who) - ?^ - u - ?: (~(has by galaxies.office) (sein who)) - =+ gal=(get-managed-galaxy (sein who)) - ?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!) - (~(get fo q.p.u.gal) who) - =+ sta=(get-managed-star (sein who)) - ?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!) - (~(get fo q.p.u.sta) who) -:: -++ mod-managed-planet :: office write - |= {who/@p mod/$-(planet planet)} ^+ +> - =+ pla=(mod (get-managed-planet who)) :: XX double traverse - ?: (~(has by planets.office) who) - +>.$(planets.office (~(put by planets.office) who pla)) - ?: (~(has by galaxies.office) (sein who)) - %+ mod-managed-galaxy (sein who) - |= gal/galaxy ^- galaxy - ?> ?=({$~ $& *} gal) - gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla)) - %+ mod-managed-star (sein who) - |= sta/star ^- star - ?> ?=({$~ $& *} sta) - sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla)) + =; res/(list ship) (some (some [%ships res])) + :: XX redundant parse? + =+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud])) + (jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships) :: ++ get-live :: last-heard time ++live |= a/ship ^- live @@ -420,88 +227,39 @@ ?~ rue %cold ?:((gth (sub now u.rue) ~m5) %seen %live) :: -++ stat-any :: unsplit status - |= {who/@p man/(managed _!!)} ^- stat - :- (get-live who) - ?~ man [%free ~] - ?: stat-no-email [%owned ''] - [%owned p.u.man] -:: -++ stat-planet :: stat of planet - |= {who/@p man/planet} ^- stat - ?. ?=({$~ $& ^} man) (stat-any who man) - :- (get-live who) - =+ pla=u:(divided man) - :- %split - %- malt - %+ turn (~(tap by box.p.pla)) - |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)])) -:: -++ stat-star :: stat of star - |= {who/@p man/star} ^- stat - ?. ?=({$~ $& ^} man) (stat-any who man) - :- (get-live who) - =+ sta=u:(divided man) - :- %split - %- malt - %+ welp - %+ turn (~(tap by box.p.sta)) - |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)])) - %+ turn (~(tap by box.q.sta)) - |=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)])) -:: -++ stat-galaxy :: stat of galaxy - |= {who/@p man/galaxy} ^- stat - ?. ?=({$~ $& ^} man) (stat-any who man) - =+ gal=u:(divided man) - :- (get-live who) - :- %split - %- malt - ;: welp - %+ turn (~(tap by box.p.gal)) - |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)])) - :: - %+ turn (~(tap by box.q.gal)) - |=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)])) - :: - %+ turn (~(tap by box.r.gal)) - |=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)])) - == :: ++ stats-ship :: inspect ship |= who/@p ^- stat - ?- (clan who) - $pawn !! - $earl !! - $duke (stat-planet who (get-managed-planet who)) - $king (stat-star who (get-managed-star who)) - $czar (stat-galaxy who (get-managed-galaxy who)) - == + :- (get-live who) + =/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner) + ?~ man [%free ~] + ?: stat-no-email [%owned ''] + [%owned u.man] :: ++ peek-x-stats :: inspect ship/system |= tyl/path ?^ tyl ?> |(=(our src) =([~ src] boss)) :: privileged info - ``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~))) - ^- (unit (unit {$womb-stat-all (map ship stat)})) - =. stat-no-email & :: censor adresses - :^ ~ ~ %womb-stat-all - %- ~(uni by (~(urn by planets.office) stat-planet)) - %- ~(uni by (~(urn by stars.office) stat-star)) - (~(urn by galaxies.office) stat-galaxy) + :: XX redundant parse? + =+ who=~|(bad-path+tyl (raid tyl /[who=%p])) + ``womb-stat+(stats-ship who) + !! :: XX meaningful and/or useful in sein-jael model? +:: ^- (unit (unit {$womb-stat-all (map ship stat)})) +:: =. stat-no-email & :: censor adresses +:: :^ ~ ~ %womb-stat-all +:: %- ~(uni by (~(urn by planets.office) stat-planet)) +:: %- ~(uni by (~(urn by stars.office) stat-star)) +:: (~(urn by galaxies.office) stat-galaxy) :: ++ peek-x-balance :: inspect invitation |= tyl/path - ?~ tyl - ?> |(=(our src) =([~ src] boss)) :: priveledged - ``[%womb-balance-all (~(run by bureau) |=(balance owner))] ^- (unit (unit {$womb-balance balance})) - =+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~)) + :: XX redundant parse? + =+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv])) %- some - %+ bind (~(get by bureau) (shaf %pass pas)) - |=(bal/balance [%womb-balance bal]) + %+ bind (jael-pas-balance pas) + |=(a/balance [%womb-balance a]) :: -:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library ++ parse-ticket |= {a/knot b/knot} ^- {him/@ tik/@} [him=(rash a old-phon) tik=(rash b old-phon)] @@ -524,7 +282,7 @@ =+ pas=`passcode`(end 7 1 (sham %tick him tik)) :- pas ?. gud %fail - ?: (~(has by bureau) (shaf %pass pas)) %used + ?^ (jael-pas-balance pas) %used %good :: ++ peer-scry-x :: subscription like .^ @@ -548,7 +306,6 @@ :: /stats general stats dump :: /stats/@p what we know about @p $stats (peek-x-stats +.tyl) - :: /balance all invitations :: /balance/passcode invitation status $balance (peek-x-balance +.tyl) :: /ticket/ship/ticket check ticket usability @@ -561,29 +318,6 @@ ?> |(=(our src) =([~ src] boss)) :: privileged .(recycling (~(put by recycling) a b)) :: -++ poke-manage :: add to property - |= a/(list ship) - =< abet - ?> |(=(our src) =([~ src] boss)) :: privileged - |- - ?~ a . - ?+ (clan i.a) ~|(bad-size+(clan i.a) !!) - $duke - ?. (~(has by planets.office) i.a) - $(a t.a, planets.office (~(put by planets.office) i.a ~)) - ~|(already-managing+i.a !!) - :: - $king - ?. (~(has by stars.office) i.a) - $(a t.a, stars.office (~(put by stars.office) i.a ~)) - ~|(already-managing+i.a !!) - :: - $czar - ?. (~(has by galaxies.office) i.a) - $(a t.a, galaxies.office (~(put by galaxies.office) i.a ~)) - ~|(already-managing+i.a !!) - == -:: ++ email :: send email |= {wir/wire adr/mail msg/tape} ^+ +> ?: replay +> :: dont's send email in replay mode @@ -610,10 +344,8 @@ $bonus (teba (poke-bonus +.pok.i.a)) $invite (teba (poke-invite +.pok.i.a)) $report (teba (poke-report +.pok.i.a)) - $release (teba (poke-release +.pok.i.a)) $recycle (teba (poke-recycle +.pok.i.a)) $reinvite (teba (poke-reinvite +.pok.i.a)) - $release-ships (teba (poke-release-ships +.pok.i.a)) == == :: @@ -623,47 +355,25 @@ =. log-transaction (log-transaction %bonus +<) ?> |(=(our src) =([~ src] boss)) :: priveledged =/ pas ~|(bad-invite+tid `passcode`(slav %uv tid)) - %_ . - bureau - %+ ~(put by bureau) (shaf %pass pas) - =/ bal ~|(%bad-passcode (~(got by bureau) (shaf %pass pas))) - bal(planets (add pla planets.bal), stars (add sta stars.bal)) - == + (emit %jaelwomb / %bonus pas pla sta) :: ++ poke-invite :: create invitation - |= {tid/cord ref/reference inv/invite} + |= {tid/cord inv/invite} =< abet =. log-transaction (log-transaction %invite +<) - =. hotel - ?~ ref hotel - ?~ sta.inv hotel - %+ ~(put by hotel) u.ref - =+ cli=(fall (~(get by hotel) u.ref) *client) - cli(sta +(sta.cli)) - (invite-from ~ tid inv) -:: -++ invite-from :: traced invitation - |= {hiz/(list mail) tid/cord inv/invite} ^+ +> ?> |(=(our src) =([~ src] boss)) :: priveledged =+ pas=~|(bad-invite+tid `passcode`(slav %uv tid)) - ?: (~(has by bureau) (shaf %pass pas)) - ~|([%duplicate-passcode pas who.inv replay=replay] !!) - =. bureau (~(put by bureau) (shaf %pass pas) [pla.inv sta.inv who.inv hiz]) + =. emit (emit %jaelwomb / %invite pas [who pla sta]:inv) (email /invite who.inv intro.wel.inv) :: -:: ++ coup-invite :: invite sent -:: ++ poke-reinvite :: split invitation |= {aut/passcode inv/invite} :: further invite =< abet =. log-transaction (log-transaction %reinvite +<) ?> =(src src) :: self-authenticated - =+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut))) - =. stars.bal (sub stars.bal sta.inv) - =. planets.bal (sub planets.bal pla.inv) - =. bureau (~(put by bureau) (shaf %pass aut) bal) - =+ tid=(scot %uv (end 7 1 (shaf %pass eny))) - (invite-from [owner.bal history.bal] tid inv) + =/ pas/@uv (end 7 1 (shaf %pass eny)) + =. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv) + (email /invite who.inv intro.wel.inv) :: ++ poke-obey :: set/reset boss |= who/(unit @p) @@ -696,47 +406,6 @@ ?> =(src src) :: self-authenticated (emit %knew /report her wyl) :: -++ use-reference :: bonus stars - |= a/(each @p mail) ^- (unit _+>) - ?. (~(has by hotel) a) ~ - =+ cli=(~(get by hotel) a) - ?~ cli ~ - ?. (gte sta.u.cli reference-rate) ~ - =. sta.u.cli (sub sta.u.cli reference-rate) - `+>.$(hotel (~(put by hotel) a u.cli)) -:: -++ poke-do-ticket :: issue child ticket - |= her/ship - =< abet - ?> =(our (sein her)) - ?> |(=(our src) =([~ src] boss)) :: privileged - =+ tik=.^(@p %a /(scot %p our)/tick/(scot %da now)/(scot %p her)) - :: =. emit (emit /tick %tick tik her) - (emit %poke /womb/tick [src %hood] [%womb-do-claim her tik]) :: XX peek result -:: -++ needy - |* a/(each * tang) - ?- -.a - $& p.a - $| ((slog (flop p.a)) (mean p.a)) - == -:: -++ poke-do-claim :: deliver ticket - |= {her/ship tik/@p} - =< abet - ^+ +> - ?> =(src (sein her)) :: from the parent which could ticket - =+ sta=(stats-ship her) - ?> ?=($cold p.sta) :: a ship not yet started - ?- -.q.sta - $free !! :: but allocated - $owned :: to an email - (email /ticket p.q.sta "Ticket for {}: {<`@pG`tik>}") - :: - $split :: or ship distribution - %.(+>.$ (slog leaf+"Ticket for {}: {<`@pG`tik>}" ~)) :: XX emit via console formally? - == -:: ++ poke-recycle :: save ticket as balance |= {who/mail him-t/knot tik-t/knot} ?. can-recycle.cfg ~|(%ticket-recycling-offline !!) @@ -746,10 +415,14 @@ =+ [him tik]=(parse-ticket him-t tik-t) ?> (need (check-old-ticket him tik)) =+ pas=`passcode`(end 7 1 (sham %tick him tik)) - ?: (~(has by bureau) (shaf %pass pas)) - ~|(already-recycled+[him-t tik-t] !!) - =+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~]) - .(bureau (~(put by bureau) (shaf %pass pas) bal)) +:: ?^ (scry-womb-invite (shaf %pass pas)) +:: ~|(already-recycled+[him-t tik-t] !!) + =/ inv/{pla/@ud sta/@ud} + ?+((clan him) !! $duke [0 1], $king [1 0]) + (emit %jaelwomb / %invite pas who inv) +:: +:: +:: ++ jael-claimed 'Move email here if an ack is necessary' :: ++ poke-claim :: claim plot, req ticket |= {aut/passcode her/@p} @@ -757,100 +430,9 @@ =< abet =. log-transaction (log-transaction %claim +<) ?> =(src src) - (claim-any aut her) -:: -++ claim-any :: register - |= {aut/passcode her/@p} - =; claimed - :: =. claimed (emit.claimed %wait $~) :: XX delay ack - (emit.claimed %poke /womb/tick [(sein her) %hood] [%womb-do-ticket her]) - =+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut))) - ?+ (clan her) ~|(bad-size+(clan her) !!) - $king - =; all (claim-star.all owner.bal her) - =+ (use-reference &+src) - ?^ - u :: prefer using references - =+ (use-reference |+owner.bal) - ?^ - u - =. stars.bal ~|(%no-stars (dec stars.bal)) - +>.$(bureau (~(put by bureau) (shaf %pass aut) bal)) - :: - $duke - =. planets.bal ~|(%no-planets (dec planets.bal)) - =. bureau (~(put by bureau) (shaf %pass aut) bal) - (claim-planet owner.bal her) - == -:: -++ claim-star :: register - |= {who/mail her/@p} ^+ +> - %+ mod-managed-star her - |= a/star ^- star - ?^ a ~|(impure-star+[her ?:(-.u.a %owned %split)] !!) - (some %| who) -:: -++ claim-planet :: register - |= {who/mail her/@p} ^+ +> - =. hotel - %+ ~(put by hotel) |+who - =+ cli=(fall (~(get by hotel) |+who) *client) - cli(has (~(put in has.cli) her)) - %+ mod-managed-planet her - |= a/planet ^- planet - ?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!) - (some %| who) -:: -++ poke-release-ships :: release specific - |= a/(list ship) - =< abet ^+ +> - =. log-transaction (log-transaction %release-ships +<) - ?> =(our src) :: privileged - %+ roll a - =+ [who=*@p res=+>.$] - |. ^+ res - ?+ (clan who) ~|(bad-size+(clan who) !!) - $king (release-star who res) - $czar (release-galaxy who res) - == -:: -++ poke-release :: release to subdivide - |= {gal/@ud sta/@ud} :: - =< abet ^+ +> - =. log-transaction (log-transaction %release +<) - ?> =(our src) :: privileged - =. +> - ?~ gal +> - =+ all=(take-n [0 gal] shop-galaxies) - ?. (gth gal (lent all)) - (roll all release-galaxy) - ~|(too-few-galaxies+[want=gal has=(lent all)] !!) - ^+ +> - ?~ sta +> - =+ all=(take-n [0 sta] shop-stars) - ~& got-stars+all - %- (slog leaf+"For issuing to proceed smoothly, immediately upon boot, ". - "each should |obey {} to honor ticket requests." ~) - ?. (gth sta (lent all)) - (roll all release-star) - ~|(too-few-stars+[want=sta has=(lent all)] !!) -:: -++ release-galaxy :: subdivide %czar - =+ [who=*@p res=.] - |. ^+ res - %+ mod-managed-galaxy:res who - |= gal/galaxy ^- galaxy - ~& release+who - ?^ gal ~|(already-used+who !!) - (some %& (fo-init 5) (fo-init 4) (fo-init 3)) -:: -++ release-star :: subdivide %king - =+ [who=*@p res=.] - |. ^+ res - =. res - %- emit.res - [%poke /womb/tick [(sein who) %hood] [%womb-do-ticket who]] - %+ mod-managed-star:res who - |= sta/star ^- star - ~& release+who - ?^ sta ~|(already-used+[who u.sta] !!) - (some %& (fo-init 5) (fo-init 4)) + =/ bal ~|(%bad-invite (need (jael-pas-balance aut))) + =/ tik/ticket (end 6 1 (shas %tick eny)) + =. emit (emit %jaelwomb / %claim aut her tik) + :: XX event crashes work properly yes? + (email /ticket owner.bal "Ticket for {}: {<`@pG`tik>}") -- diff --git a/mar/womb/do-claim.hoon b/mar/womb/do-claim.hoon deleted file mode 100644 index 72a012ceeb..0000000000 --- a/mar/womb/do-claim.hoon +++ /dev/null @@ -1,11 +0,0 @@ -:: -:::: /hoon/do-claim/womb/mar - :: -/? 310 -|_ {her/ship tik/@p} -:: -++ grab :: convert from - |% - ++ noun {ship @p} :: clam from %noun - -- --- diff --git a/mar/womb/do-ticket.hoon b/mar/womb/do-ticket.hoon deleted file mode 100644 index ff5d71ee58..0000000000 --- a/mar/womb/do-ticket.hoon +++ /dev/null @@ -1,11 +0,0 @@ -:: -:::: /hoon/do-ticket/womb/mar - :: -/? 310 -|_ her/ship -:: -++ grab :: convert from - |% - ++ noun @p :: clam from %noun - -- --- diff --git a/mar/womb/invite.hoon b/mar/womb/invite.hoon index 6d14ddd6e2..b546e32713 100644 --- a/mar/womb/invite.hoon +++ b/mar/womb/invite.hoon @@ -6,11 +6,11 @@ :: :::: ~fyr :: -|_ {cord reference invite}:womb +|_ {cord invite}:womb :: ++ grab :: convert from |% - ++ noun {cord reference invite}:womb :: clam from %noun + ++ noun {cord invite}:womb :: clam from %noun ++ json %+ corl need => jo @@ -21,7 +21,6 @@ == %- ot :~ tid+so - ref+(mu (su (pick ;~(pfix (jest '0v') viz:ag) mail))) inv+(ot who+(su mail) pla+ni sta+ni wel+(ot intro+sa hello+sa ~) ~) == --