From 7e214de97acaf2e59cb4573b1cf8db015fe04e08 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 13:36:38 -0700 Subject: [PATCH 01/24] single @pG $final --- arvo/jael.hoon | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 6424de4730..7fea708ba2 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -106,7 +106,7 @@ $% {$apple p/(map site @)} :: web api key {$block $~} :: banned {$email p/(set @ta)} :: email addresses - {$final p/(map ship @pG)} :: ticketed ships + {$final p/@pG} :: recognize by ticket {$fungi p/(map term @ud)} :: fungibles {$guest $~} :: refugee visa {$hotel p/(map dorm pile)} :: reserved block @@ -707,7 +707,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)) @@ -717,6 +717,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)} @@ -812,7 +817,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)]) @@ -822,6 +827,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)} @@ -971,7 +981,7 @@ [%apple (~(run by p.rys) |=(@ (mug +<)))] :: $final - [%final (~(run by p.rys) |=(@ (mug +<)))] + [%final (mug p.rys)] :: $login [%login ~] From 7db45d3e3b7c00e886e916eab98c9810c35261a0 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 13:40:08 -0700 Subject: [PATCH 02/24] jael womb-task outline --- arvo/jael.hoon | 91 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 90 insertions(+), 1 deletion(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 7fea708ba2..1449bdccde 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -209,8 +209,24 @@ {$vein $~} :: view signing keys {$vest $~} :: view public balance {$vine $~} :: view secret history + {$womb p/womb-task} {$west p/ship q/path r/*} :: remote request == :: +++ 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 + == :: +++ 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 ref/mail inv/invite} :: alloc to passcode + {$reinvite aut/passcode tid/passcode inv/invite} :: move to another + == -- :: :::: :::: # 1 :: private structures @@ -633,7 +649,7 @@ [n.b ~ ~] :: :: ++put:py ++ put :: insert - |= b/ship ^- pile + |= b/@ ^- pile (uni [b b] ~ ~) :: :: ++sub:py ++ sub :: subtract @@ -1168,6 +1184,13 @@ $next (cure abet:abet:(next:(burb our) eny.sys p.tac)) :: + :: + :: extend our certificate with a new private key + :: {$womb p/womb-task} + :: + $womb + (cure abet:abet:(womb:(burb our) p.tac)) + :: :: open secure channel :: {$veil p/ship} :: @@ -1877,6 +1900,72 @@ =. +>.$ (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 _!! :: STUB + ++ mov-rite _!! :: STUB + ++ del-rite _!! :: STUB + ++ womb :: manage ship %fungi + |= taz/womb-task + ^+ +> + ?- -.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) + =. ur (add-rite pas [%email who.inv]) + =. ur + (mov-rite [rex pas] [%duke pla.inv] [%king sta.inv] ~) + +>.$ + :: + :: increase existing balance + :: {$reinvite aut/passcode pla/@ud sta/@ud} + :: + $bonus + =/ pas/@p (shaf %pass tid.taz) + ?> (~(has by shy) pas) + =. ur + (mov-rite [rex pas] [%duke pla.taz] [%king 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) + =. ur (add-rite pas [%email who.inv]) + :: XX history + =/ ole/@p (shaf %pass aut.taz) + =. ur + (mov-rite [ole pas] [%duke pla.inv] [%king sta.inv] ~) + +>.$ + :: + :: redeem ship invitation + :: {$claim aut/passcode her/@p tik/ticket} + :: + $claim + =/ pas/@p (shaf %pass aut.taz) + ?> =(our (sein her.taz)) + =/ len (xeb (xeb her.taz)) + =. ur + (del-rite pas [%fungi (my [?+(len !! $4 $king, $5 $earl) 1] ~)]) + =. ur + (del-rite our [%hotel (as-hotel her.taz)]) + =. ur (add-rite her.taz [%final tik.taz]) + +>.$ + == :: :: grow:ex:ur ++ grow :: merge wills |= $: :: vie: data source From e8244463a20e975708bfc94752eebe2de624ea99 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 14:29:00 -0700 Subject: [PATCH 03/24] define {add,mov,del}-rite --- arvo/jael.hoon | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 1449bdccde..b9d034a81e 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -1908,9 +1908,18 @@ :- [(sein a) b] (put:py (rsh (dec b) 1 a)) :: - ++ add-rite _!! :: STUB - ++ mov-rite _!! :: STUB - ++ del-rite _!! :: STUB + ++ 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 ~ ~])) + :: ++ womb :: manage ship %fungi |= taz/womb-task ^+ +> @@ -1923,10 +1932,9 @@ =/ pas/@p (shaf %pass tid.taz) =* inv inv.taz ?< (~(has by shy) pas) - =. ur (add-rite pas [%email who.inv]) - =. ur - (mov-rite [rex pas] [%duke pla.inv] [%king sta.inv] ~) - +>.$ + =. +>.$ (add-rite pas [%email (sy who.inv ~)]) + %+ mov-rite [rex pas] + [%fungi (my [%duke pla.inv] [%king sta.inv] ~)] :: :: increase existing balance :: {$reinvite aut/passcode pla/@ud sta/@ud} @@ -1934,9 +1942,8 @@ $bonus =/ pas/@p (shaf %pass tid.taz) ?> (~(has by shy) pas) - =. ur - (mov-rite [rex pas] [%duke pla.taz] [%king sta.taz] ~) - +>.$ + %+ mov-rite [rex pas] + [%fungi (my [%duke pla.taz] [%king sta.taz] ~)] :: :: split passcode balance :: {$reinvite aut/passcode tid/passcode inv/{who/mail pla/@ud sta/@ud}} @@ -1945,26 +1952,24 @@ =/ pas/@p (shaf %pass tid.taz) =* inv inv.taz ?< (~(has by shy) pas) - =. ur (add-rite pas [%email who.inv]) + =. +>.$ (add-rite pas [%email (sy who.inv ~)]) :: XX history =/ ole/@p (shaf %pass aut.taz) - =. ur - (mov-rite [ole pas] [%duke pla.inv] [%king sta.inv] ~) - +>.$ + %+ mov-rite [ole pas] + [%fungi (my [%duke pla.inv] [%king sta.inv] ~)] :: :: redeem ship invitation :: {$claim aut/passcode her/@p tik/ticket} :: $claim =/ pas/@p (shaf %pass aut.taz) - ?> =(our (sein her.taz)) + ?> =(rex (sein her.taz)) :: XX deal with foreign ships? =/ len (xeb (xeb her.taz)) - =. ur - (del-rite pas [%fungi (my [?+(len !! $4 $king, $5 $earl) 1] ~)]) - =. ur + =. +>.$ + (del-rite pas [%fungi (my [(clan her.taz) 1] ~)]) + =. +>.$ (del-rite our [%hotel (as-hotel her.taz)]) - =. ur (add-rite her.taz [%final tik.taz]) - +>.$ + (add-rite her.taz [%final tik.taz]) == :: :: grow:ex:ur ++ grow :: merge wills From 817a4023fb4fc4df238f9cf02531f139232bdff4 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 14:53:55 -0700 Subject: [PATCH 04/24] remove referral tracking --- gen/hood/invite.hoon | 6 +++--- lib/womb.hoon | 38 ++++---------------------------------- 2 files changed, 7 insertions(+), 37 deletions(-) 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/lib/womb.hoon b/lib/womb.hoon index 4ca51a57c8..8880796a91 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -56,10 +56,6 @@ 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 @@ -75,10 +71,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,7 +94,7 @@ $: boss/(unit ship) :: outside master bureau/(map passhash balance) :: active invitations office/property :: properties managed - hotel/(map (each ship mail) client) :: everyone we know + hotel/(jug mail ship) :: everyone we know recycling/(map ship @) :: old ticket keys == :: -- :: @@ -143,7 +135,7 @@ {$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} == -- @@ -629,15 +621,9 @@ == :: ++ 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 @@ -693,15 +679,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 @@ -765,10 +742,6 @@ ?+ (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)) :: @@ -787,10 +760,7 @@ :: ++ 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)) + =. hotel (~(put ju hotel) who her) %+ mod-managed-planet her |= a/planet ^- planet ?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!) From e13ca8452ca7a2c191e4b33797f3875f48ba9122 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 15:25:10 -0700 Subject: [PATCH 05/24] direct womb claims to jael --- lib/womb.hoon | 169 ++++++++++++++++++++++++++------------------------ 1 file changed, 89 insertions(+), 80 deletions(-) diff --git a/lib/womb.hoon b/lib/womb.hoon index 8880796a91..15eebd0656 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -613,27 +613,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 inv/invite} =< abet =. log-transaction (log-transaction %invite +<) - (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) +:: :: +:: ++ 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]) +:: (email /invite who.inv intro.wel.inv) :: :: ++ coup-invite :: invite sent :: @@ -643,11 +641,12 @@ =. 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) +:: =. stars.bal (sub stars.bal sta.inv) +:: =. planets.bal (sub planets.bal pla.inv) +:: =. bureau (~(put by bureau) (shaf %pass aut) bal) + =/ 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) @@ -679,14 +678,14 @@ ?> =(src src) :: self-authenticated (emit %knew /report her wyl) :: -++ 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 +:: ++ 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) @@ -695,21 +694,21 @@ $| ((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-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} @@ -720,10 +719,16 @@ =+ [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)) + =/ inv/{pla/@ud sta/@ud} + ?+((clan him) !! $duke [0 1], $king [1 0]) + (emit / %jaelwomb %invite pas who inv) +:: ?: (~(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)) +:: +:: +:: ++ jael-claimed 'Move email here if an ack is necessary' :: ++ poke-claim :: claim plot, req ticket |= {aut/passcode her/@p} @@ -731,41 +736,45 @@ =< 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) - =. 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 ju hotel) who her) - %+ mod-managed-planet her - |= a/planet ^- planet - ?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!) - (some %| who) -:: + =/ tik/ticket (end 6 1 (shas %tick eny)) + =. emit (emit / %jaelwomb %claim aut her tik) + :: XX event crashes work properly yes? + (email /ticket p.q.sta "Ticket for {}: {<`@pG`tik>}") +:: (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) +:: =. 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 ju hotel) who 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 ^+ +> From d79802307db7050549c6148cba8a6f2403471dc0 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 15:46:23 -0700 Subject: [PATCH 06/24] fixup types --- app/hood.hoon | 3 ++- arvo/jael.hoon | 2 +- lib/womb.hoon | 38 +++++++++++++++++++++++++------------- 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/app/hood.hoon b/app/hood.hoon index 4745a0ef12..f205fd9e35 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -61,7 +61,8 @@ :: ++ ably :: save part |* {(list) hood-part} - [(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))] + =/ par/hood-part +<+ + [(flop +<-) %_(+> lac (~(put by lac) -.par par))] :: :: :: :::: :: :: :: :: :: diff --git a/arvo/jael.hoon b/arvo/jael.hoon index b9d034a81e..d3a9e4f4b5 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -224,7 +224,7 @@ ++ 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 ref/mail inv/invite} :: alloc to passcode + {$invite tid/passcode inv/invite} :: alloc to passcode {$reinvite aut/passcode tid/passcode inv/invite} :: move to another == -- diff --git a/lib/womb.hoon b/lib/womb.hoon index 15eebd0656..60e6d5cab3 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -102,6 +102,13 @@ :::: :: :: :: :: :: |% :: arvo structures +++ invite-j {who/mail pla/@ud sta/@ud} :: invite 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} :: {$info wire @p @tas nori} :: fs write (backup) @@ -111,6 +118,7 @@ {$next wire p/ring} :: update private key {$tick wire p/@pG q/@p} :: save ticket {$knew wire p/ship q/will} :: learn will (old pki) + {$jaelwomb wire womb-task} :: manage rights == :: ++ pear :: $% {$email mail tape wall} :: send email @@ -613,7 +621,7 @@ =. log-transaction (log-transaction %bonus +<) ?> |(=(our src) =([~ src] boss)) :: priveledged =/ pas ~|(bad-invite+tid `passcode`(slav %uv tid)) - (emit / %jaelwomb %bonus pas pla sta) + (emit %jaelwomb / %bonus pas pla sta) :: ++ poke-invite :: create invitation |= {tid/cord inv/invite} @@ -621,7 +629,7 @@ =. log-transaction (log-transaction %invite +<) ?> |(=(our src) =([~ src] boss)) :: priveledged =+ pas=~|(bad-invite+tid `passcode`(slav %uv tid)) - =. emit (emit / %jaelwomb %invite pas [who pla sta]:inv) + =. emit (emit %jaelwomb / %invite pas [who pla sta]:inv) (email /invite who.inv intro.wel.inv) :: :: :: ++ invite-from :: traced invitation @@ -645,7 +653,7 @@ :: =. planets.bal (sub planets.bal pla.inv) :: =. bureau (~(put by bureau) (shaf %pass aut) bal) =/ pas/@uv (end 7 1 (shaf %pass eny)) - =. emit (emit / %jaelwomb %reinvite aut pas [who pla sta]:inv) + =. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv) (email /invite who.inv intro.wel.inv) :: ++ poke-obey :: set/reset boss @@ -678,9 +686,11 @@ ?> =(src src) :: self-authenticated (emit %knew /report her wyl) :: -:: ++ poke-do-ticket :: issue child ticket -:: |= her/ship -:: =< abet +++ 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)) @@ -694,10 +704,11 @@ $| ((slog (flop p.a)) (mean p.a)) == :: -:: ++ poke-do-claim :: deliver ticket -:: |= {her/ship tik/@p} -:: =< abet -:: ^+ +> +++ 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 @@ -721,7 +732,7 @@ =+ pas=`passcode`(end 7 1 (sham %tick him tik)) =/ inv/{pla/@ud sta/@ud} ?+((clan him) !! $duke [0 1], $king [1 0]) - (emit / %jaelwomb %invite pas who inv) + (emit %jaelwomb / %invite pas who inv) :: ?: (~(has by bureau) (shaf %pass pas)) :: ~|(already-recycled+[him-t tik-t] !!) :: =+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~]) @@ -737,9 +748,10 @@ =. log-transaction (log-transaction %claim +<) ?> =(src src) =/ tik/ticket (end 6 1 (shas %tick eny)) - =. emit (emit / %jaelwomb %claim aut her tik) + =. emit (emit %jaelwomb / %claim aut her tik) :: XX event crashes work properly yes? - (email /ticket p.q.sta "Ticket for {}: {<`@pG`tik>}") + =/ adr/mail !! :: XX scry jael + (email /ticket adr "Ticket for {}: {<`@pG`tik>}") :: (claim-any aut her) :: :: :: ++ claim-any :: register From eea13f8ce362c86e3feab245624b01869aba9264 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 15:57:22 -0700 Subject: [PATCH 07/24] cleaning --- lib/womb.hoon | 94 +++-------------------------------------- mar/womb/do-claim.hoon | 11 ----- mar/womb/do-ticket.hoon | 11 ----- 3 files changed, 5 insertions(+), 111 deletions(-) delete mode 100644 mar/womb/do-claim.hoon delete mode 100644 mar/womb/do-ticket.hoon diff --git a/lib/womb.hoon b/lib/womb.hoon index 60e6d5cab3..d064647933 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -499,7 +499,6 @@ %+ bind (~(get by bureau) (shaf %pass pas)) |=(bal/balance [%womb-balance bal]) :: -:: ++ 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)] @@ -631,17 +630,6 @@ =+ pas=~|(bad-invite+tid `passcode`(slav %uv tid)) =. emit (emit %jaelwomb / %invite pas [who pla sta]:inv) (email /invite who.inv intro.wel.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]) -:: (email /invite who.inv intro.wel.inv) -:: -:: ++ coup-invite :: invite sent :: ++ poke-reinvite :: split invitation |= {aut/passcode inv/invite} :: further invite @@ -649,9 +637,6 @@ =. 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) =/ 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) @@ -686,41 +671,6 @@ ?> =(src src) :: self-authenticated (emit %knew /report her wyl) :: -++ 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 !!) @@ -730,13 +680,11 @@ =+ [him tik]=(parse-ticket him-t tik-t) ?> (need (check-old-ticket him tik)) =+ pas=`passcode`(end 7 1 (sham %tick him tik)) +:: ?^ (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) -:: ?: (~(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)) :: :: :: ++ jael-claimed 'Move email here if an ack is necessary' @@ -749,44 +697,12 @@ ?> =(src src) =/ tik/ticket (end 6 1 (shas %tick eny)) =. emit (emit %jaelwomb / %claim aut her tik) + :: =. hotel (~(put ju hotel) who her) :: XX derived state? :: XX event crashes work properly yes? =/ adr/mail !! :: XX scry jael (email /ticket adr "Ticket for {}: {<`@pG`tik>}") -:: (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) -:: =. 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 ju hotel) who 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 ^+ +> 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 - -- --- From d29e30acdb4ca20d6baccf4c99a944de21439c40 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 16:16:47 -0700 Subject: [PATCH 08/24] comment out releasing ships (should implicitly release self?) --- app/hood.hoon | 6 +-- lib/womb.hoon | 112 +++++++++++++++++++++++++------------------------- 2 files changed, 59 insertions(+), 59 deletions(-) diff --git a/app/hood.hoon b/app/hood.hoon index f205fd9e35..3c913f5418 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -170,11 +170,11 @@ ++ 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-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-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/lib/womb.hoon b/lib/womb.hoon index d064647933..2c062a0ce9 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -138,8 +138,8 @@ :: ++ transaction :: logged poke $% {$report her/@p wyl/will} - {$release gal/@ud sta/@ud} - {$release-ships (list ship)} +:: {$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} @@ -607,10 +607,10 @@ $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)) +:: $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)) +:: $release-ships (teba (poke-release-ships +.pok.i.a)) == == :: @@ -703,56 +703,56 @@ (email /ticket adr "Ticket for {}: {<`@pG`tik>}") :: :: -++ 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)) +:: ++ 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)) -- From 143cb2110233659c32814dae9d733b8d9c3535a0 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 16:17:57 -0700 Subject: [PATCH 09/24] better tap:py --- arvo/jael.hoon | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index d3a9e4f4b5..ae9fbc68a1 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -672,10 +672,10 @@ $(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~]) :: ++ tap - =| out/(list (pair ship ship)) + =| out/(list ship) |- ^+ 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 From 295d30ef7d7c37548b43d8b09e42393b6bf7af10 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 16:18:10 -0700 Subject: [PATCH 10/24] disable office and related code --- lib/womb.hoon | 641 +++++++++++++++++++++++++------------------------- 1 file changed, 322 insertions(+), 319 deletions(-) diff --git a/lib/womb.hoon b/lib/womb.hoon index 2c062a0ce9..d8ca224485 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -6,46 +6,46 @@ :: :: :: :::: :: :: :: :: :: -|% -++ 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 @@ -56,11 +56,11 @@ owner/mail :: owner's email history/(list mail) :: transfer history == :: -++ 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 @@ -93,8 +93,7 @@ ++ pith :: womb content $: boss/(unit ship) :: outside master bureau/(map passhash balance) :: active invitations - office/property :: properties managed - hotel/(jug mail ship) :: everyone we know +:: office/property :: properties managed recycling/(map ship @) :: old ticket keys == :: -- :: @@ -131,7 +130,7 @@ {$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 @@ -168,86 +167,86 @@ =+ 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) +:: ++ 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-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) - == - == - -- +:: ++ 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) +:: == +:: == +:: -- -- :: :: :: :::: :: :: @@ -271,31 +270,31 @@ ?~(+< +> $(+< 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])) +:: ++ 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)] +:: ++ 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) @@ -310,107 +309,109 @@ |= {b/ship *} ?=(^ (ames-last-seen b)) :: -++ shop-galaxies (available galaxies.office) :: unassigned %czar -:: -:: 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)) :: +:: ++ shop-galaxies (available galaxies.office) :: unassigned %czar +:: :: +:: :: 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])) + =; res/(list ship) (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) - == + !! :: XX scry jael +:: ?+ 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)) +:: ++ 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)) :: ++ get-live :: last-heard time ++live |= a/ship ^- live @@ -418,75 +419,78 @@ ?~ 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)])) - == +:: ++ 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) + !! :: XX scry jael +:: ?- (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)) +:: == :: ++ 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 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 @@ -558,28 +562,28 @@ ?> |(=(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 !!) - == +:: ++ 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} ^+ +> @@ -697,7 +701,6 @@ ?> =(src src) =/ tik/ticket (end 6 1 (shas %tick eny)) =. emit (emit %jaelwomb / %claim aut her tik) - :: =. hotel (~(put ju hotel) who her) :: XX derived state? :: XX event crashes work properly yes? =/ adr/mail !! :: XX scry jael (email /ticket adr "Ticket for {}: {<`@pG`tik>}") From 746e4b1dfae7c8c5f646424672d1abdcd7fb26f2 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 16:26:30 -0700 Subject: [PATCH 11/24] stray balance references --- lib/womb.hoon | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lib/womb.hoon b/lib/womb.hoon index d8ca224485..1b90d13e47 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -92,7 +92,7 @@ ++ part {$womb $1 pith} :: womb state ++ pith :: womb content $: boss/(unit ship) :: outside master - bureau/(map passhash balance) :: active invitations +:: bureau/(map passhash balance) :: active invitations :: office/property :: properties managed recycling/(map ship @) :: old ticket keys == :: @@ -355,7 +355,7 @@ =; res/(list ship) (some (some [%ships res])) =+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~)) :: =. nth (mul 3 nth) - !! :: XX scry jael + !! :: XX scry jael /=shop=/[typ]/[nth] :: ?+ typ ~|(bad-type+typ !!) :: $galaxies (take-n [nth 3] shop-galaxies) :: $planets (take-n [nth 3] shop-planets) @@ -470,7 +470,7 @@ ++ stats-ship :: inspect ship |= who/@p ^- stat :- (get-live who) - !! :: XX scry jael + !! :: XX scry jael /=stats=/[who] :: ?- (clan who) :: $pawn !! :: $earl !! @@ -494,14 +494,15 @@ :: ++ 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 ~)) - %- some - %+ bind (~(get by bureau) (shaf %pass pas)) - |=(bal/balance [%womb-balance bal]) + !! :: XX scry jael /=balance= +:: ?~ 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 ~)) +:: %- some +:: %+ bind (~(get by bureau) (shaf %pass pas)) +:: |=(bal/balance [%womb-balance bal]) :: ++ parse-ticket |= {a/knot b/knot} ^- {him/@ tik/@} @@ -525,8 +526,9 @@ =+ pas=`passcode`(end 7 1 (sham %tick him tik)) :- pas ?. gud %fail - ?: (~(has by bureau) (shaf %pass pas)) %used - %good + !! :: XX scry jael /=balance=/(shaf %pass pas) +:: ?: (~(has by bureau) (shaf %pass pas)) %used +:: %good :: ++ peer-scry-x :: subscription like .^ |= tyl/path @@ -640,7 +642,6 @@ =< abet =. log-transaction (log-transaction %reinvite +<) ?> =(src src) :: self-authenticated - =+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut))) =/ 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) @@ -702,7 +703,7 @@ =/ tik/ticket (end 6 1 (shas %tick eny)) =. emit (emit %jaelwomb / %claim aut her tik) :: XX event crashes work properly yes? - =/ adr/mail !! :: XX scry jael + =/ adr/mail !! :: XX scry jael /=balance=/[aut] (email /ticket adr "Ticket for {}: {<`@pG`tik>}") :: :: From 1939a2bf84e5310283ca18cf13135ea85298eb68 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 17:11:19 -0700 Subject: [PATCH 12/24] scry skeleton --- arvo/jael.hoon | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index ae9fbc68a1..28952db68e 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -227,6 +227,18 @@ {$invite tid/passcode inv/invite} :: alloc to passcode {$reinvite aut/passcode tid/passcode inv/invite} :: move to another == +++ womb-scry + $% {$shop typ/?($star $planet) nth/@u} :: available ships + {$balance aut/passcode} :: invite details + {$balance-all $~} :: all invites + == +++ womb-balance {who/mail pla/@ud sta/@ud} :: equivalent to invite? +++ womb-gilt + $% {$ships (list ship)} :: + {$womb-balance (unit womb-balance)} :: + {$womb-balance-all (map passhash mail)} :: + == +++ gilt ?(womb-gilt) -- :: :::: :::: # 1 :: private structures @@ -1115,6 +1127,12 @@ ++ burb :: per ship |= who/ship ~(able ~(ex ur urb) who) + :: :: ++scry:of + ++ scry :: read + |= {syd/@tas pax/path} ^- (unit (unit gilt)) + ?+ syd [~ ~] + $womb ``[%ships ~] + == :: :: ++call:of ++ call :: invoke |= $: :: hen: event cause @@ -2246,7 +2264,13 @@ tyl/spur == ^- (unit (unit cage)) - ~ + :: XX security + ?. =(lot [%$ %da now]) ~ + ?. =(%x ren) ~ + %+ bind (~(scry of [now eny] lex) syd (flop tyl)) + |= a/(unit gilt) + %+ bind a + |=(b/gilt [-.b (slot 3 (spec !>(b)))]) :: :: ++stay ++ stay :: preserve lex From 906d02447e5306886844484d6f62f21ed9f371bd Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 17:11:51 -0700 Subject: [PATCH 13/24] remove irrelevant manage/release infrastructure, foils --- app/hood.hoon | 3 - lib/womb.hoon | 213 -------------------------------------------------- 2 files changed, 216 deletions(-) diff --git a/app/hood.hoon b/app/hood.hoon index 3c913f5418..e0871d4ddf 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -170,11 +170,8 @@ ++ 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/lib/womb.hoon b/lib/womb.hoon index 1b90d13e47..e6169b124b 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -137,8 +137,6 @@ :: ++ transaction :: logged poke $% {$report her/@p wyl/will} -:: {$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} @@ -167,86 +165,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) -:: == -:: == -:: -- -- :: :: :: :::: :: :: @@ -269,32 +189,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) @@ -363,11 +257,6 @@ :: == :: :: ++ 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) @@ -376,16 +265,6 @@ :: ?. ?=({$~ $& *} 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) @@ -398,20 +277,6 @@ :: ?. ?=({$~ $& *} 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)) :: ++ get-live :: last-heard time ++live |= a/ship ^- live @@ -564,29 +429,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 @@ -613,10 +455,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)) == == :: @@ -706,57 +546,4 @@ =/ adr/mail !! :: XX scry jael /=balance=/[aut] (email /ticket adr "Ticket for {}: {<`@pG`tik>}") :: -:: -:: ++ 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)) -- From 4ca53042dbc6ca22f047aad68f8d155855ada69b Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 12 Oct 2016 19:01:58 -0700 Subject: [PATCH 14/24] mostly implement jaelwomb scry --- arvo/jael.hoon | 82 +++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 75 insertions(+), 7 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 28952db68e..f120554456 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -684,7 +684,7 @@ $(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~]) :: ++ tap - =| out/(list ship) + =| out/(list @u) |- ^+ out ?~ a out $(a l.a, out (welp (gulf n.a) $(a r.a))) @@ -1127,11 +1127,27 @@ ++ burb :: per ship |= who/ship ~(able ~(ex ur urb) who) + :: + ++ read-womb + |= pax/path ^- (unit womb-scry) + ?~ pax ~ + ?+ i.pax ~ + $balance-all ?^(t.pax ~ `[%balance-all ~]) + $balance + %+ bind (read t.pax %uv ~) + |=(a/passcode [%balance 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 (unit gilt)) - ?+ syd [~ ~] - $womb ``[%ships ~] + |= {syd/@tas pax/path} ^- (unit gilt) + ?+ syd ~ + $womb (biff (read-womb pax) scry-womb:(burb our)) == :: :: ++call:of ++ call :: invoke @@ -1989,6 +2005,59 @@ (del-rite our [%hotel (as-hotel her.taz)]) (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/womb-scry ^- (unit womb-gilt) + ?- -.req + :: + :: all invites + :: {$balance-all $~} + :: + $balance-all + !! :: XX index which fakesubs are invites + :: + :: invite details + :: {$balance aut/passcode} + :: + $balance + %+ some %womb-balance + %+ bind (~(get by shy) (shaf %pass aut.req)) + |= a/safe ^- womb-balance + =/ 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 @@ -2266,11 +2335,10 @@ ^- (unit (unit cage)) :: XX security ?. =(lot [%$ %da now]) ~ + %- some ?. =(%x ren) ~ %+ bind (~(scry of [now eny] lex) syd (flop tyl)) - |= a/(unit gilt) - %+ bind a - |=(b/gilt [-.b (slot 3 (spec !>(b)))]) + |=(a/gilt [-.a (slot 3 (spec !>(a)))]) :: :: ++stay ++ stay :: preserve lex From d7fce2d56cbef8273ceb13b56493993e51e252b0 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 11:50:57 -0700 Subject: [PATCH 15/24] compiling hood --- app/hood.hoon | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/app/hood.hoon b/app/hood.hoon index e0871d4ddf..62dedf8ea9 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -61,8 +61,7 @@ :: ++ ably :: save part |* {(list) hood-part} - =/ par/hood-part +<+ - [(flop +<-) %_(+> lac (~(put by lac) -.par par))] + [(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))] :: :: :: :::: :: :: :: :: :: @@ -166,8 +165,6 @@ ++ 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-recycle (wrap poke-recycle):from-womb From 6e0f2666c6698da764bc0a885a020c9a7a4a3098 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 12:17:20 -0700 Subject: [PATCH 16/24] move ++make to ++ex:ur to avoid our usage --- arvo/jael.hoon | 139 +++++++++++++++++++++++++------------------------ 1 file changed, 70 insertions(+), 69 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index f120554456..aa8fac259e 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -1176,7 +1176,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} @@ -1719,6 +1719,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) @@ -1761,73 +1763,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 @@ -1912,6 +1847,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} @@ -2002,7 +2003,7 @@ =. +>.$ (del-rite pas [%fungi (my [(clan her.taz) 1] ~)]) =. +>.$ - (del-rite our [%hotel (as-hotel her.taz)]) + (del-rite rex [%hotel (as-hotel her.taz)]) (add-rite her.taz [%final tik.taz]) == :: :: div-at-most:ex:ur From fbc6fdb35e76930d89d25f9ff0b8fae5a1d41e22 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 12:38:09 -0700 Subject: [PATCH 17/24] autoload %jael --- lib/kiln.hoon | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/kiln.hoon b/lib/kiln.hoon index 2c009c08a0..66d677bae5 100644 --- a/lib/kiln.hoon +++ b/lib/kiln.hoon @@ -190,7 +190,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) @@ -242,7 +242,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 +>.$ From 45961a84fc58e03e5d44e0bc38dd37538e033b2a Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 12:39:34 -0700 Subject: [PATCH 18/24] refine womb scry set --- arvo/jael.hoon | 33 ++++++++++++++++++++++----------- lib/womb.hoon | 6 +----- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index aa8fac259e..ac51613103 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -229,14 +229,14 @@ == ++ womb-scry $% {$shop typ/?($star $planet) nth/@u} :: available ships + {$stats who/ship} :: ship details {$balance aut/passcode} :: invite details - {$balance-all $~} :: all invites == ++ womb-balance {who/mail pla/@ud sta/@ud} :: equivalent to invite? ++ womb-gilt $% {$ships (list ship)} :: + {$womb-owner (unit mail)} :: {$womb-balance (unit womb-balance)} :: - {$womb-balance-all (map passhash mail)} :: == ++ gilt ?(womb-gilt) -- @@ -1132,13 +1132,16 @@ |= pax/path ^- (unit womb-scry) ?~ pax ~ ?+ i.pax ~ - $balance-all ?^(t.pax ~ `[%balance-all ~]) $balance - %+ bind (read t.pax %uv ~) + %+ 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 ~) + %+ biff (read t.pax /[%tas]/[%ud]) |= {typ/term nth/@u} ?. ?=(?($star $planet) typ) ~ `[%shop typ nth] @@ -2004,6 +2007,8 @@ (del-rite pas [%fungi (my [(clan her.taz) 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 @@ -2015,11 +2020,17 @@ |= req/womb-scry ^- (unit womb-gilt) ?- -.req :: - :: all invites - :: {$balance-all $~} + :: ship details + :: {$stats who/ship} :: - $balance-all - !! :: XX index which fakesubs are invites + $stats + %+ some %womb-owner + %+ bind (~(get by shy) who.req) + |= a/safe ^- mail + :: XX deal with multiple emails? + =+ (need (~(expose up a) %email)) + ?> ?=({$email {@ $~ $~}} -) + n.p.- :: :: invite details :: {$balance aut/passcode} @@ -2337,8 +2348,8 @@ :: XX security ?. =(lot [%$ %da now]) ~ %- some - ?. =(%x ren) ~ - %+ bind (~(scry of [now eny] lex) syd (flop tyl)) + ?. =(%$ ren) ~ + %+ bind (~(scry of [now eny] lex) syd tyl) |=(a/gilt [-.a (slot 3 (spec !>(a)))]) :: :: ++stay ++ stay :: preserve diff --git a/lib/womb.hoon b/lib/womb.hoon index e6169b124b..5df6902f5b 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -359,10 +359,7 @@ :: ++ peek-x-balance :: inspect invitation |= tyl/path - !! :: XX scry jael /=balance= -:: ?~ tyl -:: ?> |(=(our src) =([~ src] boss)) :: priveledged -:: ``[%womb-balance-all (~(run by bureau) |=(balance owner))] + !! :: XX scry jael /=balance=/[pas] :: ^- (unit (unit {$womb-balance balance})) :: =+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~)) :: %- some @@ -416,7 +413,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 From bd899fffad0f7b607c7eb7195ce9f91341c02315 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 13:16:53 -0700 Subject: [PATCH 19/24] use jael scry in womb --- lib/womb.hoon | 175 +++++++++----------------------------------------- 1 file changed, 32 insertions(+), 143 deletions(-) diff --git a/lib/womb.hoon b/lib/womb.hoon index 5df6902f5b..a0bc92c578 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -102,12 +102,13 @@ :: :: :: |% :: 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} :: {$info wire @p @tas nori} :: fs write (backup) @@ -197,86 +198,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)) +:: +++ 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] :: :: -:: ++ shop-galaxies (available galaxies.office) :: unassigned %czar -:: :: -:: :: 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/(list ship) (some (some [%ships res])) - =+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~)) - :: =. nth (mul 3 nth) - !! :: XX scry jael /=shop=/[typ]/[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 -:: ++ 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)) ~) -:: :: -:: ++ 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) -:: :: + :: 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 @@ -284,71 +224,22 @@ ?~ 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 :- (get-live who) - !! :: XX scry jael /=stats=/[who] -:: ?- (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)) -:: == + =/ 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 ~))) + :: 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 @@ -359,12 +250,12 @@ :: ++ peek-x-balance :: inspect invitation |= tyl/path - !! :: XX scry jael /=balance=/[pas] -:: ^- (unit (unit {$womb-balance balance})) -:: =+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~)) -:: %- some -:: %+ bind (~(get by bureau) (shaf %pass pas)) -:: |=(bal/balance [%womb-balance bal]) + ^- (unit (unit {$womb-balance balance})) + :: XX redundant parse? + =+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv])) + %- some + %+ bind (jael-pas-balance pas) + |=(a/balance [%womb-balance a]) :: ++ parse-ticket |= {a/knot b/knot} ^- {him/@ tik/@} @@ -388,9 +279,8 @@ =+ pas=`passcode`(end 7 1 (sham %tick him tik)) :- pas ?. gud %fail - !! :: XX scry jael /=balance=/(shaf %pass pas) -:: ?: (~(has by bureau) (shaf %pass pas)) %used -:: %good + ?^ (jael-pas-balance pas) %used + %good :: ++ peer-scry-x :: subscription like .^ |= tyl/path @@ -536,10 +426,9 @@ =< abet =. log-transaction (log-transaction %claim +<) ?> =(src src) + =/ 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? - =/ adr/mail !! :: XX scry jael /=balance=/[aut] - (email /ticket adr "Ticket for {}: {<`@pG`tik>}") -:: + (email /ticket owner.bal "Ticket for {}: {<`@pG`tik>}") -- From 4865d46030f9ccfbfd1cb37980b13b9ee77d604b Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 15:07:46 -0700 Subject: [PATCH 20/24] fixup ++we names --- arvo/jael.hoon | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index ac51613103..a5ed5634bd 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -1058,16 +1058,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)) @@ -1075,7 +1075,7 @@ ?~(- ~ `i) :: :: ++reverse:we ++ reverse :: sort latest first - (collate |=({a/{life *} b/{life *}} (gth -.a -.b))) + (collate |=({{a/life *} {b/life *}} (gth a b))) -- -- :: :::: From 90fdda735643821a4ec28e52c50339022e9edadd Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 15:20:28 -0700 Subject: [PATCH 21/24] route %jaelwomb tasks, fix ++call --- arvo/gall.hoon | 1 + arvo/jael.hoon | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/arvo/gall.hoon b/arvo/gall.hoon index b79a052958..f8a1c30347 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -1195,6 +1195,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 a5ed5634bd..d864bee436 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -209,7 +209,7 @@ {$vein $~} :: view signing keys {$vest $~} :: view public balance {$vine $~} :: view secret history - {$womb p/womb-task} + {$jaelwomb p/womb-task} {$west p/ship q/path r/*} :: remote request == :: ++ ticket @G :: old 64-bit ticket @@ -1223,9 +1223,9 @@ :: :: :: extend our certificate with a new private key - :: {$womb p/womb-task} + :: {$jaelwomb p/womb-task} :: - $womb + $jaelwomb (cure abet:abet:(womb:(burb our) p.tac)) :: :: open secure channel @@ -2308,7 +2308,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 From 007a03d65930ea34392f7afec23152cc082a0ec6 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 16:07:58 -0700 Subject: [PATCH 22/24] remove reference from mar/womb/invite --- mar/womb/invite.hoon | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) 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 ~) ~) == -- From 8147803abc3f3c31318eb3830390bb677a850521 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 13 Oct 2016 16:16:47 -0700 Subject: [PATCH 23/24] fix ++mail type, %fungi ship names, delete semantics --- arvo/jael.hoon | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/arvo/jael.hoon b/arvo/jael.hoon index d864bee436..5839eeba9b 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -105,7 +105,7 @@ ++ rite :: urbit commitment $% {$apple p/(map site @)} :: web api key {$block $~} :: banned - {$email p/(set @ta)} :: email addresses + {$email p/(set @t)} :: email addresses {$final p/@pG} :: recognize by ticket {$fungi p/(map term @ud)} :: fungibles {$guest $~} :: refugee visa @@ -926,7 +926,7 @@ |= ryt/rite ^- safe ?~ pig - ~ + !! :: not found ?. =(-.ryt -.n.pig) ?: (gor -.ryt -.n.pig) [n.pig $(pig l.pig) r.pig] @@ -1972,7 +1972,7 @@ ?< (~(has by shy) pas) =. +>.$ (add-rite pas [%email (sy who.inv ~)]) %+ mov-rite [rex pas] - [%fungi (my [%duke pla.inv] [%king sta.inv] ~)] + [%fungi (my [%upl pla.inv] [%usr sta.inv] ~)] :: :: increase existing balance :: {$reinvite aut/passcode pla/@ud sta/@ud} @@ -1981,7 +1981,7 @@ =/ pas/@p (shaf %pass tid.taz) ?> (~(has by shy) pas) %+ mov-rite [rex pas] - [%fungi (my [%duke pla.taz] [%king sta.taz] ~)] + [%fungi (my [%upl pla.taz] [%usr sta.taz] ~)] :: :: split passcode balance :: {$reinvite aut/passcode tid/passcode inv/{who/mail pla/@ud sta/@ud}} @@ -1994,7 +1994,7 @@ :: XX history =/ ole/@p (shaf %pass aut.taz) %+ mov-rite [ole pas] - [%fungi (my [%duke pla.inv] [%king sta.inv] ~)] + [%fungi (my [%upl pla.inv] [%usr sta.inv] ~)] :: :: redeem ship invitation :: {$claim aut/passcode her/@p tik/ticket} @@ -2003,8 +2003,9 @@ =/ 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 [(clan her.taz) 1] ~)]) + (del-rite pas [%fungi (my [fun 1] ~)]) =. +>.$ (del-rite rex [%hotel (as-hotel her.taz)]) =/ who (need %.(%email ~(expose up (lawn pas)))) From 12fc5e6cf376ff979173210b5ff6ca424b202d92 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 20 Oct 2016 18:58:45 -0700 Subject: [PATCH 24/24] hacks: init jael on boot --- arvo/ames.hoon | 1 + arvo/jael.hoon | 8 ++++++-- arvo/zuse.hoon | 1 + gen/solid.hoon | 1 + 4 files changed, 9 insertions(+), 2 deletions(-) diff --git a/arvo/ames.hoon b/arvo/ames.hoon index 6e9530fb76..825a6f7385 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -2027,6 +2027,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/jael.hoon b/arvo/jael.hoon index 5839eeba9b..e2bc6b2e64 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -199,7 +199,8 @@ ++ task :: in request ->$ $% {$burn p/ship q/safe} :: destroy rights {$hail p/ship q/remote} :: remote update - {$init p/@pG q/arms} :: initialize urbit + {$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 @@ -1179,7 +1180,9 @@ :: {$init p/code q/arms} :: $init - (cure abet:abet:(make:(burb our) 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} @@ -1961,6 +1964,7 @@ ++ womb :: manage ship %fungi |= taz/womb-task ^+ +> + ~& [taz shy] ?- -.taz :: :: create passcode balance diff --git a/arvo/zuse.hoon b/arvo/zuse.hoon index e5087eb3ce..e3325087b3 100644 --- a/arvo/zuse.hoon +++ b/arvo/zuse.hoon @@ -3940,6 +3940,7 @@ {$e kiss-eyre} {$f kiss-ford} {$g kiss-gall} + {$j $init ship} :: XX actual jael tasks == == ++ sign-arvo :: in result $<- $% {$a gift-ames} 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