ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-21 07:28:30 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'jaelwomb' into cc-release

Browse Source
This commit is contained in:
Anton Dyudin 2016-11-11 17:48:20 -08:00
commit 13bc8ea59f
12 changed files with 441 additions and 661 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
app/hood.hoon
View File

@ -61,7 +61,7 @@
::
++ ably :: save part
|* {(list) hood-part}
[(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))]
[(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))]
:: :: ::
:::: :: ::
:: :: ::
@ -165,15 +165,10 @@
++ poke-womb-obey (wrap poke-obey):from-womb
++ poke-womb-bonus (wrap poke-bonus):from-womb
++ poke-womb-claim (wrap poke-claim):from-womb
++ poke-womb-do-ticket (wrap poke-do-ticket):from-womb
++ poke-womb-do-claim (wrap poke-do-claim):from-womb
++ poke-womb-rekey (wrap poke-rekey):from-womb
++ poke-womb-report (wrap poke-report):from-womb
++ poke-womb-manage (wrap poke-manage):from-womb
++ poke-womb-recycle (wrap poke-recycle):from-womb
++ poke-womb-manage-old-key (wrap poke-manage-old-key):from-womb
++ poke-womb-release (wrap poke-release):from-womb
++ poke-womb-release-ships (wrap poke-release-ships):from-womb
++ poke-womb-reinvite (wrap poke-reinvite):from-womb
++ poke-womb-replay-log (wrap poke-replay-log):from-womb
++ poke-write-sec-atom (wrap poke-sec-atom):from-write

1
arvo/ames.hoon
View File

@ -2041,6 +2041,7 @@
:_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~]))
~& [%beer p.bon]
:* [hen [%slip %c %init p.bon]]
[hen [%slip %j %init p.bon]]
[hen [%give %init p.bon]]
[hen [%slip %a %kick now]]
[hen [%slip %e %init p.bon]]

1
arvo/gall.hoon
View File

@ -1196,6 +1196,7 @@
$wont `%a :: XX for begin; remove
$warp `%c
$wipe `%f :: XX cache clear
$jaelwomb `%j :: XX name/unpack
==
--
--

349
arvo/jael.hoon
View File

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

72
arvo/zuse.hoon
View File

@ -922,22 +922,57 @@
%+ each balance :: complete
action :: change
::
++ task :: in request ->$
$% {$burn p/ship q/safe} :: destroy rights
{$hail p/ship q/remote} :: remote update
{$init p/@pG q/arms} :: initialize urbit
{$meet p/(unit (unit ship)) q/farm} :: integrate pki from
{$mint p/ship q/safe} :: create rights
{$move p/ship q/ship r/safe} :: transfer from/to
{$next p/bull} :: update private key
{$nuke $~} :: cancel tracker from
{$veil p/ship} :: view secret channel
{$vein $~} :: view signing keys
{$vest $~} :: view public balance
{$vine $~} :: view secret history
{$west p/ship q/path r/*} :: remote request
== ::
-- :: moves
++ task :: in request ->$
$% {$burn p/ship q/safe} :: destroy rights
{$hail p/ship q/remote} :: remote update
{$init p/@p}
:: {$init p/@pG q/arms} :: initialize urbit
{$meet p/(unit (unit ship)) q/farm} :: integrate pki from
{$mint p/ship q/safe} :: create rights
{$move p/ship q/ship r/safe} :: transfer from/to
{$next p/bull} :: update private key
{$nuke $~} :: cancel tracker from
{$veil p/ship} :: view secret channel
{$vein $~} :: view signing keys
{$vest $~} :: view public balance
{$vine $~} :: view secret history
{$jaelwomb p/task:womb}
{$west p/ship q/path r/*} :: remote request
== ::
++ gilt gilt:womb
--
::
++ womb ^?
:: types used to serve the lib/womb invite controller
|%
++ ticket @G :: old 64-bit ticket
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
++ mail @t :: email address
++ invite ::
$: who/mail :: owner email
pla/@ud :: planets to send
sta/@ud :: stars to send
== ::
:: ::
++ task :: manage ship %fungi
$% {$claim aut/passcode her/@p tik/ticket} :: convert to %final
{$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode
{$invite tid/passcode inv/invite} :: alloc to passcode
{$reinvite aut/passcode tid/passcode inv/invite}:: move to another
==
++ scry
$% {$shop typ/?($star $planet) nth/@u} :: available ships
{$stats who/ship} :: ship details
{$balance aut/passcode} :: invite details
==
++ balance {who/mail pla/@ud sta/@ud} :: equivalent to invite?
++ gilt
$% {$ships (list ship)} ::
{$womb-owner (unit mail)} ::
{$womb-balance (unit balance)} ::
==
--
:: ::
:::: ++pki:^jael :: (1h2) certificates
:: ::::
@ -1030,8 +1065,8 @@
++ rite :: urbit commitment
$% {$apple p/(map site @)} :: web api key
{$block $~} :: banned
{$email p/(set @ta)} :: email addresses
{$final p/(map ship @pG)} :: ticketed ships
{$email p/(set @t)} :: email addresses
{$final p/@pG} :: recognize by ticket
{$fungi p/(map term @ud)} :: fungibles
{$guest $~} :: refugee visa
{$hotel p/(map dorm pile)} :: reserved block
@ -4516,6 +4551,7 @@
{$e task:able:^eyre}
{$f task:able:^ford}
{$g task:able:^gall}
{$j $init ship} :: XX actual jael tasks
== ==
++ sign-arvo :: in result $<-
$% {$a gift:able:^ames}

6
gen/hood/invite.hoon
View File

@ -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"]]

1
gen/solid.hoon
View File

@ -28,6 +28,7 @@
[%b %behn]
[%d %dill]
[%e %eyre]
[%j %jael]
==
|- ^+ all
?~ vay all

4
lib/kiln.hoon
View File

@ -192,7 +192,7 @@
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
=. cur-vanes
%- malt
%+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
%+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
|= syd/@tas
:- syd
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
@ -244,7 +244,7 @@
|= {way/wire rot/riot}
?> ?=($~ way)
?> ?=(^ rot)
=+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
=+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
=. +>.$
?. autoload
+>.$

634
lib/womb.hoon
View File

@ -5,49 +5,50 @@
/+ talk, old-phon
=, wired:eyre
=, title:jael
=, womb:^jael
:: :: ::
:::: :: ::
:: :: ::
|%
++ foil :: ship allocation map
|* mold :: entry mold
$: min/@u :: minimum entry
ctr/@u :: next allocated
und/(set @u) :: free under counter
ove/(set @u) :: alloc over counter
max/@u :: maximum entry
box/(map @u +<) :: entries
== ::
-- ::
:: |%
:: ++ foil :: ship allocation map
:: |* mold :: entry mold
:: $: min/@u :: minimum entry
:: ctr/@u :: next allocated
:: und/(set @u) :: free under counter
:: ove/(set @u) :: alloc over counter
:: max/@u :: maximum entry
:: box/(map @u +<) :: entries
:: == ::
:: -- ::
:: ::
:::: ::
:: ::
|% ::
++ managed :: managed plot
|* mold ::
%- unit :: unsplit
%+ each +< :: subdivided
mail :: delivered
:: ::
++ divided :: get division state
|* (managed) ::
?- +< ::
$~ ~ :: unsplit
{$~ $| *} ~ :: delivered
{$~ $& *} (some p.u.+<) :: subdivided
== ::
:: ::
++ moon (managed _!!) :: undivided moon
::
++ planet :: subdivided planet
(managed (lone (foil moon))) ::
:: ::
++ star :: subdivided star
(managed (pair (foil moon) (foil planet))) ::
:: ::
++ galaxy :: subdivided galaxy
(managed (trel (foil moon) (foil planet) (foil star)))::
:: ::
:: ++ managed :: managed plot
:: |* mold ::
:: %- unit :: unsplit
:: %+ each +< :: subdivided
:: mail :: delivered
:: :: ::
:: ++ divided :: get division state
:: |* (managed) ::
:: ?- +< ::
:: $~ ~ :: unsplit
:: {$~ $| *} ~ :: delivered
:: {$~ $& *} (some p.u.+<) :: subdivided
:: == ::
:: :: ::
:: ++ moon (managed _!!) :: undivided moon
:: ::
:: ++ planet :: subdivided planet
:: (managed (lone (foil moon))) ::
:: :: ::
:: ++ star :: subdivided star
:: (managed (pair (foil moon) (foil planet))) ::
:: :: ::
:: ++ galaxy :: subdivided galaxy
:: (managed (trel (foil moon) (foil planet) (foil star)))::
:: :: ::
++ ticket @G :: old 64-bit ticket
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
@ -58,15 +59,11 @@
owner/mail :: owner's email
history/(list mail) :: transfer history
== ::
++ client :: per email
$: sta/@ud :: unused star refs
has/(set @p) :: planets owned
== ::
++ property :: subdivided plots
$: galaxies/(map @p galaxy) :: galaxy
planets/(map @p planet) :: star
stars/(map @p star) :: planet
== ::
:: ++ property :: subdivided plots
:: $: galaxies/(map @p galaxy) :: galaxy
:: planets/(map @p planet) :: star
:: stars/(map @p star) :: planet
:: == ::
++ invite ::
$: who/mail :: who to send to
pla/@ud :: planets to send
@ -77,10 +74,6 @@
$: intro/tape :: in invite email
hello/tape :: as talk message
== ::
++ reference :: affiliate credit
(unit (each @p mail)) :: ship or email
:: ::
++ reference-rate 2 :: star refs per star
++ stat (pair live dist) :: external info
++ live ?($cold $seen $live) :: online status
++ dist :: allocation
@ -102,9 +95,8 @@
++ part {$womb $1 pith} :: womb state
++ pith :: womb content
$: boss/(unit ship) :: outside master
bureau/(map passhash balance) :: active invitations
office/property :: properties managed
hotel/(map (each ship mail) client) :: everyone we know
:: bureau/(map passhash balance) :: active invitations
:: office/property :: properties managed
recycling/(map ship @) :: old ticket keys
== ::
-- ::
@ -112,6 +104,14 @@
:::: :: ::
:: :: ::
|% :: arvo structures
++ invite-j {who/mail pla/@ud sta/@ud} :: invite data
++ balance-j {who/mail pla/@ud sta/@ud} :: balance data
++ womb-task :: manage ship %fungi
$% {$claim aut/passcode her/@p tik/ticket} :: convert to %final
{$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode
{$invite tid/passcode inv/invite-j} :: alloc to passcode
{$reinvite aut/passcode tid/passcode inv/invite-j}:: move to another
== ::
++ card ::
$% {$flog wire flog:^dill} ::
{$info wire @p @tas nori:^clay} :: fs write (backup)
@ -120,7 +120,8 @@
{$poke wire dock pear} :: app RPC
{$next wire p/ring} :: update private key
{$tick wire p/@pG q/@p} :: save ticket
{$knew wire p/ship q/wyll:^ames} :: learn wyll (old pki)
{$knew wire p/ship q/wyll:^ames} :: learn will (old pki)
{$jaelwomb wire task:womb} :: manage rights
== ::
++ pear ::
$% {$email mail tape wall} :: send email
@ -133,19 +134,17 @@
{$womb-balance balance} ::
{$womb-balance-all (map passhash mail)} ::
{$womb-stat stat} ::
{$womb-stat-all (map ship stat)} ::
:: {$womb-stat-all (map ship stat)} ::
{$womb-ticket-info passcode ?($fail $good $used)} ::
==
++ move (pair bone card) :: user-level move
::
++ transaction :: logged poke
$% {$report her/@p wyl/wyll:^ames}
{$release gal/@ud sta/@ud}
{$release-ships (list ship)}
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
{$bonus tid/cord pla/@ud sta/@ud}
{$invite tid/cord ref/reference inv/invite}
{$invite tid/cord inv/invite}
{$reinvite aut/passcode inv/invite}
==
--
@ -170,86 +169,8 @@
=+ d=(b q.c)
?~(d ~ (some [p.c u.d]))
::
++ unsplit
|= a/(map ship (managed)) ^- (list {ship *})
%+ skim (~(tap by a))
|=({@ a/(managed)} ?=($~ a))
::
++ issuing
|* a/(map ship (managed))
^- (list {ship _(need (divided *~(got by a)))})
(sort (~(tap by (murn-by a divided))) lor)
::
++ issuing-under
|* {a/bloq b/ship c/(map @u (managed))}
^- (list {ship _(need (divided *~(got by c)))})
%+ turn (sort (~(tap by (murn-by c divided))) lor)
|*(d/{@u *} [(rep a b -.d ~) +.d])
++ cursor (pair (unit ship) @u)
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
::
:: Create new foil of size
++ fo-init
|= a/bloq :: ^- (foil *)
[min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
::
++ fo
|_ (foil $@($~ *))
++ nth :: index
|= a/@u ^- (pair (unit @u) @u)
?: (lth a ~(wyt in und))
=+ out=(snag a (sort (~(tap in und)) lth))
[(some out) 0]
=. a (sub a ~(wyt in und))
|- ^- {(unit @u) @u}
?: =(ctr +(max)) [~ a]
?: =(0 a) [(some ctr) a]
$(a (dec a), +<.nth new)
::
+- fin +< :: abet
++ new :: alloc
?: =(ctr +(max)) +<
=. ctr +(ctr)
?. (~(has in ove) ctr) +<
new(ove (~(del in ove) ctr))
::
+- get :: nullable
|= a/@p ^+ ?~(box ~ q.n.box)
(fall (~(get by box) (neis a)) ~)
::
+- put
|* {a/@u b/*} ^+ fin :: b/_(~(got by box))
~| put+[a fin]
?> (fit a)
=; adj adj(box (~(put by box) a b))
?: (~(has in box) a) fin
?: =(ctr a) new
?: (lth a ctr)
?. (~(has in und) a) fin
fin(und (~(del in und) a))
?. =(a ctr:new) :: heuristic
fin(ove (~(put in ove) a))
=+ n=new(+< new)
n(und (~(put in und.n) ctr))
::
++ fit |=(a/@u &((lte min a) (lte a max))) :: in range
++ gud :: invariant
?& (fit(max +(max)) ctr)
(~(all in und) fit(max ctr))
(~(all in ove) fit(min ctr))
(~(all in box) |=({a/@u *} (fit a)))
|- ^- ?
?: =(min max) &
=- &(- $(min +(min)))
%+ gte 1 :: at most one of
;: add
?:(=(min ctr) 1 0)
?:((~(has in und) min) 1 0)
?:((~(has in ove) min) 1 0)
?:((~(has by box) min) 1 0)
==
==
--
--
:: :: ::
:::: :: ::
@ -272,32 +193,6 @@
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
::
++ take-n :: compute range
|= {{index/@u count/@u} get/$-(@u cursor)}
^- (list ship)
?~ count ~
%+ biff p:(get index)
|= a/ship ^- (list ship)
[a ^$(index +(index), count (dec count))]
::
++ available :: enumerate free ships
|= all/(map ship (managed)) ^- $-(@u cursor)
=+ pur=(sort (turn (unsplit all) head) lth)
=+ len=(lent pur)
|=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a]))
::
:: foil cursor to ship cursor, using sized parent
++ prefix
|= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor
?~ c [c d]
[(some (rep a b u.c ~)) d]
::
++ in-list :: distribute among options
|* {a/(list) b/@u} ^+ [(snag *@ a) b]
=+ c=(lent a)
[(snag (mod b c) a) (div b c)]
::
++ ames-last-seen :: last succesful ping
|= a/ship ~+ ^- (unit time)
?: =(a our) (some now)
@ -306,113 +201,25 @@
%+ ames-grab %rue
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
::
++ neighboured :: filter for connectivity
|* a/(list {ship *}) ^+ a
%+ skim a
|= {b/ship *}
?=(^ (ames-last-seen b))
++ jael-scry
|* {typ/mold pax/path} ^- typ
.^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax))
::
++ shop-galaxies (available galaxies.office) :: unassigned %czar
++ jael-pas-balance
|= pas/passcode ^- (unit balance)
%+ bind (jael-scry (unit balance-j) /balance/(scot %uv pas)/womb-balance)
|= a/balance-j ^- balance
=/ hiz/(list mail) ~ :: XX track history in jael
[pla.a sta.a who.a hiz]
::
:: Stars can be either whole or children of galaxies
++ shop-stars :: unassigned %king
|= nth/@u ^- cursor
=^ out nth %.(nth (available stars.office))
?^ out [out nth]
%+ shop-star nth
(neighboured (issuing galaxies.office))
::
++ shop-star :: star from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
(prefix 3 who.sel (~(nth fo r.sel) nth))
::
++ shop-planets :: unassigned %duke
|= nth/@u ^- cursor
=^ out nth %.(nth (available planets.office))
?^ out [out nth]
=^ out nth
%+ shop-planet nth
(neighboured (issuing stars.office))
?^ out [out nth]
(shop-planet-gal nth (issuing galaxies.office))
::
++ shop-planet :: planet from stars
|= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor
?: =(~ sta) [~ nth]
=^ sel nth (in-list sta nth)
(prefix 4 who.sel (~(nth fo q.sel) nth))
::
++ shop-planet-gal :: planet from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
%+ shop-planet nth
(neighboured (issuing-under 3 who.sel box.r.sel))
::
++ peek-x-shop :: available ships
|= tyl/path ^- (unit (unit {$ships (list @p)}))
=; a ~& peek-x-shop+[tyl a] a
=; res (some (some [%ships res]))
=+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
:: =. nth (mul 3 nth)
?+ typ ~|(bad-type+typ !!)
$galaxies (take-n [nth 3] shop-galaxies)
$planets (take-n [nth 3] shop-planets)
$stars (take-n [nth 3] shop-stars)
==
::
++ get-managed-galaxy ~(got by galaxies.office) :: office read
++ mod-managed-galaxy :: office write
|= {who/@p mod/$-(galaxy galaxy)} ^+ +>
=+ gal=(mod (get-managed-galaxy who))
+>.$(galaxies.office (~(put by galaxies.office) who gal))
::
++ get-managed-star :: office read
|= who/@p ^- star
=+ (~(get by stars.office) who)
?^ - u
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!)
(fall (~(get by box.r.p.u.gal) (neis who)) ~)
::
++ mod-managed-star :: office write
|= {who/@p mod/$-(star star)} ^+ +>
=+ sta=(mod (get-managed-star who)) :: XX double traverse
?: (~(has by stars.office) who)
+>.$(stars.office (~(put by stars.office) who sta))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta))
::
++ get-managed-planet :: office read
|= who/@p ^- planet
=+ (~(get by planets.office) who)
?^ - u
?: (~(has by galaxies.office) (sein who))
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!)
(~(get fo q.p.u.gal) who)
=+ sta=(get-managed-star (sein who))
?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!)
(~(get fo q.p.u.sta) who)
::
++ mod-managed-planet :: office write
|= {who/@p mod/$-(planet planet)} ^+ +>
=+ pla=(mod (get-managed-planet who)) :: XX double traverse
?: (~(has by planets.office) who)
+>.$(planets.office (~(put by planets.office) who pla))
?: (~(has by galaxies.office) (sein who))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla))
%+ mod-managed-star (sein who)
|= sta/star ^- star
?> ?=({$~ $& *} sta)
sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla))
=; res/(list ship) (some (some [%ships res]))
:: XX redundant parse?
=+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud]))
(jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships)
::
++ get-live :: last-heard time ++live
|= a/ship ^- live
@ -420,88 +227,39 @@
?~ rue %cold
?:((gth (sub now u.rue) ~m5) %seen %live)
::
++ stat-any :: unsplit status
|= {who/@p man/(managed _!!)} ^- stat
:- (get-live who)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned p.u.man]
::
++ stat-planet :: stat of planet
|= {who/@p man/planet} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ pla=u:(divided man)
:- %split
%- malt
%+ turn (~(tap by box.p.pla))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
++ stat-star :: stat of star
|= {who/@p man/star} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ sta=u:(divided man)
:- %split
%- malt
%+ welp
%+ turn (~(tap by box.p.sta))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
%+ turn (~(tap by box.q.sta))
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
++ stat-galaxy :: stat of galaxy
|= {who/@p man/galaxy} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
=+ gal=u:(divided man)
:- (get-live who)
:- %split
%- malt
;: welp
%+ turn (~(tap by box.p.gal))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
%+ turn (~(tap by box.q.gal))
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
%+ turn (~(tap by box.r.gal))
|=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)]))
==
::
++ stats-ship :: inspect ship
|= who/@p ^- stat
?- (clan who)
$pawn !!
$earl !!
$duke (stat-planet who (get-managed-planet who))
$king (stat-star who (get-managed-star who))
$czar (stat-galaxy who (get-managed-galaxy who))
==
:- (get-live who)
=/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned u.man]
::
++ peek-x-stats :: inspect ship/system
|= tyl/path
?^ tyl
?> |(=(our src) =([~ src] boss)) :: privileged info
``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
^- (unit (unit {$womb-stat-all (map ship stat)}))
=. stat-no-email & :: censor adresses
:^ ~ ~ %womb-stat-all
%- ~(uni by (~(urn by planets.office) stat-planet))
%- ~(uni by (~(urn by stars.office) stat-star))
(~(urn by galaxies.office) stat-galaxy)
:: XX redundant parse?
=+ who=~|(bad-path+tyl (raid tyl /[who=%p]))
``womb-stat+(stats-ship who)
!! :: XX meaningful and/or useful in sein-jael model?
:: ^- (unit (unit {$womb-stat-all (map ship stat)}))
:: =. stat-no-email & :: censor adresses
:: :^ ~ ~ %womb-stat-all
:: %- ~(uni by (~(urn by planets.office) stat-planet))
:: %- ~(uni by (~(urn by stars.office) stat-star))
:: (~(urn by galaxies.office) stat-galaxy)
::
++ peek-x-balance :: inspect invitation
|= tyl/path
?~ tyl
?> |(=(our src) =([~ src] boss)) :: priveledged
``[%womb-balance-all (~(run by bureau) |=(balance owner))]
^- (unit (unit {$womb-balance balance}))
=+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~))
:: XX redundant parse?
=+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv]))
%- some
%+ bind (~(get by bureau) (shaf %pass pas))
|=(bal/balance [%womb-balance bal])
%+ bind (jael-pas-balance pas)
|=(a/balance [%womb-balance a])
::
:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library
++ parse-ticket
|= {a/knot b/knot} ^- {him/@ tik/@}
[him=(rash a old-phon) tik=(rash b old-phon)]
@ -524,7 +282,7 @@
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:- pas
?. gud %fail
?: (~(has by bureau) (shaf %pass pas)) %used
?^ (jael-pas-balance pas) %used
%good
::
++ peer-scry-x :: subscription like .^
@ -548,7 +306,6 @@
:: /stats general stats dump
:: /stats/@p what we know about @p
$stats (peek-x-stats +.tyl)
:: /balance all invitations
:: /balance/passcode invitation status
$balance (peek-x-balance +.tyl)
:: /ticket/ship/ticket check ticket usability
@ -561,29 +318,6 @@
?> |(=(our src) =([~ src] boss)) :: privileged
.(recycling (~(put by recycling) a b))
::
++ poke-manage :: add to property
|= a/(list ship)
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
|-
?~ a .
?+ (clan i.a) ~|(bad-size+(clan i.a) !!)
$duke
?. (~(has by planets.office) i.a)
$(a t.a, planets.office (~(put by planets.office) i.a ~))
~|(already-managing+i.a !!)
::
$king
?. (~(has by stars.office) i.a)
$(a t.a, stars.office (~(put by stars.office) i.a ~))
~|(already-managing+i.a !!)
::
$czar
?. (~(has by galaxies.office) i.a)
$(a t.a, galaxies.office (~(put by galaxies.office) i.a ~))
~|(already-managing+i.a !!)
==
::
++ email :: send email
|= {wir/wire adr/mail msg/tape} ^+ +>
?: replay +> :: dont's send email in replay mode
@ -610,10 +344,8 @@
$bonus (teba (poke-bonus +.pok.i.a))
$invite (teba (poke-invite +.pok.i.a))
$report (teba (poke-report +.pok.i.a))
$release (teba (poke-release +.pok.i.a))
$recycle (teba (poke-recycle +.pok.i.a))
$reinvite (teba (poke-reinvite +.pok.i.a))
$release-ships (teba (poke-release-ships +.pok.i.a))
==
==
::
@ -623,47 +355,25 @@
=. log-transaction (log-transaction %bonus +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
%_ .
bureau
%+ ~(put by bureau) (shaf %pass pas)
=/ bal ~|(%bad-passcode (~(got by bureau) (shaf %pass pas)))
bal(planets (add pla planets.bal), stars (add sta stars.bal))
==
(emit %jaelwomb / %bonus pas pla sta)
::
++ poke-invite :: create invitation
|= {tid/cord ref/reference inv/invite}
|= {tid/cord inv/invite}
=< abet
=. log-transaction (log-transaction %invite +<)
=. hotel
?~ ref hotel
?~ sta.inv hotel
%+ ~(put by hotel) u.ref
=+ cli=(fall (~(get by hotel) u.ref) *client)
cli(sta +(sta.cli))
(invite-from ~ tid inv)
::
++ invite-from :: traced invitation
|= {hiz/(list mail) tid/cord inv/invite} ^+ +>
?> |(=(our src) =([~ src] boss)) :: priveledged
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
?: (~(has by bureau) (shaf %pass pas))
~|([%duplicate-passcode pas who.inv replay=replay] !!)
=. bureau (~(put by bureau) (shaf %pass pas) [pla.inv sta.inv who.inv hiz])
=. emit (emit %jaelwomb / %invite pas [who pla sta]:inv)
(email /invite who.inv intro.wel.inv)
::
:: ++ coup-invite :: invite sent
::
++ poke-reinvite :: split invitation
|= {aut/passcode inv/invite} :: further invite
=< abet
=. log-transaction (log-transaction %reinvite +<)
?> =(src src) :: self-authenticated
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
=. stars.bal (sub stars.bal sta.inv)
=. planets.bal (sub planets.bal pla.inv)
=. bureau (~(put by bureau) (shaf %pass aut) bal)
=+ tid=(scot %uv (end 7 1 (shaf %pass eny)))
(invite-from [owner.bal history.bal] tid inv)
=/ pas/@uv (end 7 1 (shaf %pass eny))
=. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
(email /invite who.inv intro.wel.inv)
::
++ poke-obey :: set/reset boss
|= who/(unit @p)
@ -696,47 +406,6 @@
?> =(src src) :: self-authenticated
(emit %knew /report her wyl)
::
++ use-reference :: bonus stars
|= a/(each @p mail) ^- (unit _+>)
?. (~(has by hotel) a) ~
=+ cli=(~(get by hotel) a)
?~ cli ~
?. (gte sta.u.cli reference-rate) ~
=. sta.u.cli (sub sta.u.cli reference-rate)
`+>.$(hotel (~(put by hotel) a u.cli))
::
++ poke-do-ticket :: issue child ticket
|= her/ship
=< abet
?> =(our (sein her))
?> |(=(our src) =([~ src] boss)) :: privileged
=+ tik=.^(@p %a /(scot %p our)/tick/(scot %da now)/(scot %p her))
:: =. emit (emit /tick %tick tik her)
(emit %poke /womb/tick [src %hood] [%womb-do-claim her tik]) :: XX peek result
::
++ needy
|* a/(each * tang)
?- -.a
$& p.a
$| ((slog (flop p.a)) (mean p.a))
==
::
++ poke-do-claim :: deliver ticket
|= {her/ship tik/@p}
=< abet
^+ +>
?> =(src (sein her)) :: from the parent which could ticket
=+ sta=(stats-ship her)
?> ?=($cold p.sta) :: a ship not yet started
?- -.q.sta
$free !! :: but allocated
$owned :: to an email
(email /ticket p.q.sta "Ticket for {<her>}: {<`@pG`tik>}")
::
$split :: or ship distribution
%.(+>.$ (slog leaf+"Ticket for {<her>}: {<`@pG`tik>}" ~)) :: XX emit via console formally?
==
::
++ poke-recycle :: save ticket as balance
|= {who/mail him-t/knot tik-t/knot}
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
@ -746,10 +415,14 @@
=+ [him tik]=(parse-ticket him-t tik-t)
?> (need (check-old-ticket him tik))
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
?: (~(has by bureau) (shaf %pass pas))
~|(already-recycled+[him-t tik-t] !!)
=+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~])
.(bureau (~(put by bureau) (shaf %pass pas) bal))
:: ?^ (scry-womb-invite (shaf %pass pas))
:: ~|(already-recycled+[him-t tik-t] !!)
=/ inv/{pla/@ud sta/@ud}
?+((clan him) !! $duke [0 1], $king [1 0])
(emit %jaelwomb / %invite pas who inv)
::
::
:: ++ jael-claimed 'Move email here if an ack is necessary'
::
++ poke-claim :: claim plot, req ticket
|= {aut/passcode her/@p}
@ -757,100 +430,9 @@
=< abet
=. log-transaction (log-transaction %claim +<)
?> =(src src)
(claim-any aut her)
::
++ claim-any :: register
|= {aut/passcode her/@p}
=; claimed
:: =. claimed (emit.claimed %wait $~) :: XX delay ack
(emit.claimed %poke /womb/tick [(sein her) %hood] [%womb-do-ticket her])
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
?+ (clan her) ~|(bad-size+(clan her) !!)
$king
=; all (claim-star.all owner.bal her)
=+ (use-reference &+src)
?^ - u :: prefer using references
=+ (use-reference |+owner.bal)
?^ - u
=. stars.bal ~|(%no-stars (dec stars.bal))
+>.$(bureau (~(put by bureau) (shaf %pass aut) bal))
::
$duke
=. planets.bal ~|(%no-planets (dec planets.bal))
=. bureau (~(put by bureau) (shaf %pass aut) bal)
(claim-planet owner.bal her)
==
::
++ claim-star :: register
|= {who/mail her/@p} ^+ +>
%+ mod-managed-star her
|= a/star ^- star
?^ a ~|(impure-star+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ claim-planet :: register
|= {who/mail her/@p} ^+ +>
=. hotel
%+ ~(put by hotel) |+who
=+ cli=(fall (~(get by hotel) |+who) *client)
cli(has (~(put in has.cli) her))
%+ mod-managed-planet her
|= a/planet ^- planet
?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ poke-release-ships :: release specific
|= a/(list ship)
=< abet ^+ +>
=. log-transaction (log-transaction %release-ships +<)
?> =(our src) :: privileged
%+ roll a
=+ [who=*@p res=+>.$]
|. ^+ res
?+ (clan who) ~|(bad-size+(clan who) !!)
$king (release-star who res)
$czar (release-galaxy who res)
==
::
++ poke-release :: release to subdivide
|= {gal/@ud sta/@ud} ::
=< abet ^+ +>
=. log-transaction (log-transaction %release +<)
?> =(our src) :: privileged
=. +>
?~ gal +>
=+ all=(take-n [0 gal] shop-galaxies)
?. (gth gal (lent all))
(roll all release-galaxy)
~|(too-few-galaxies+[want=gal has=(lent all)] !!)
^+ +>
?~ sta +>
=+ all=(take-n [0 sta] shop-stars)
~& got-stars+all
%- (slog leaf+"For issuing to proceed smoothly, immediately upon boot, ".
"each should |obey {<our>} to honor ticket requests." ~)
?. (gth sta (lent all))
(roll all release-star)
~|(too-few-stars+[want=sta has=(lent all)] !!)
::
++ release-galaxy :: subdivide %czar
=+ [who=*@p res=.]
|. ^+ res
%+ mod-managed-galaxy:res who
|= gal/galaxy ^- galaxy
~& release+who
?^ gal ~|(already-used+who !!)
(some %& (fo-init 5) (fo-init 4) (fo-init 3))
::
++ release-star :: subdivide %king
=+ [who=*@p res=.]
|. ^+ res
=. res
%- emit.res
[%poke /womb/tick [(sein who) %hood] [%womb-do-ticket who]]
%+ mod-managed-star:res who
|= sta/star ^- star
~& release+who
?^ sta ~|(already-used+[who u.sta] !!)
(some %& (fo-init 5) (fo-init 4))
=/ bal ~|(%bad-invite (need (jael-pas-balance aut)))
=/ tik/ticket (end 6 1 (shas %tick eny))
=. emit (emit %jaelwomb / %claim aut her tik)
:: XX event crashes work properly yes?
(email /ticket owner.bal "Ticket for {<her>}: {<`@pG`tik>}")
--

11
mar/womb/do-claim.hoon
View File

@ -1,11 +0,0 @@
::
:::: /hoon/do-claim/womb/mar
::
/? 310
|_ {her/ship tik/@p}
::
++ grab :: convert from
|%
++ noun {ship @p} :: clam from %noun
--
--

11
mar/womb/do-ticket.hoon
View File

@ -1,11 +0,0 @@
::
:::: /hoon/do-ticket/womb/mar
::
/? 310
|_ her/ship
::
++ grab :: convert from
|%
++ noun @p :: clam from %noun
--
--

5
mar/womb/invite.hoon
View File

@ -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 ~) ~)
==
--