mirror of
https://github.com/urbit/shrub.git
synced 2025-01-04 10:32:34 +03:00
Merge branch 'jaelwomb' into cc-release
This commit is contained in:
Anton Dyudin
commit
13bc8ea59f
@ -61,7 +61,7 @@
|
|||||||
::
|
::
|
||||||
++ ably :: save part
|
++ ably :: save part
|
||||||
|* {(list) hood-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-obey (wrap poke-obey):from-womb
|
||||||
++ poke-womb-bonus (wrap poke-bonus):from-womb
|
++ poke-womb-bonus (wrap poke-bonus):from-womb
|
||||||
++ poke-womb-claim (wrap poke-claim):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-rekey (wrap poke-rekey):from-womb
|
||||||
++ poke-womb-report (wrap poke-report):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-recycle (wrap poke-recycle):from-womb
|
||||||
++ poke-womb-manage-old-key (wrap poke-manage-old-key):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-reinvite (wrap poke-reinvite):from-womb
|
||||||
++ poke-womb-replay-log (wrap poke-replay-log):from-womb
|
++ poke-womb-replay-log (wrap poke-replay-log):from-womb
|
||||||
++ poke-write-sec-atom (wrap poke-sec-atom):from-write
|
++ poke-write-sec-atom (wrap poke-sec-atom):from-write
|
||||||
|
|||||||
@ -2041,6 +2041,7 @@
|
|||||||
:_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~]))
|
:_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~]))
|
||||||
~& [%beer p.bon]
|
~& [%beer p.bon]
|
||||||
:* [hen [%slip %c %init p.bon]]
|
:* [hen [%slip %c %init p.bon]]
|
||||||
|
[hen [%slip %j %init p.bon]]
|
||||||
[hen [%give %init p.bon]]
|
[hen [%give %init p.bon]]
|
||||||
[hen [%slip %a %kick now]]
|
[hen [%slip %a %kick now]]
|
||||||
[hen [%slip %e %init p.bon]]
|
[hen [%slip %e %init p.bon]]
|
||||||
|
|||||||
@ -1196,6 +1196,7 @@
|
|||||||
$wont `%a :: XX for begin; remove
|
$wont `%a :: XX for begin; remove
|
||||||
$warp `%c
|
$warp `%c
|
||||||
$wipe `%f :: XX cache clear
|
$wipe `%f :: XX cache clear
|
||||||
|
$jaelwomb `%j :: XX name/unpack
|
||||||
==
|
==
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
|||||||
349
arvo/jael.hoon
349
arvo/jael.hoon
@ -21,6 +21,7 @@
|
|||||||
=, able:^jael
|
=, able:^jael
|
||||||
=, title:jael
|
=, title:jael
|
||||||
=, crypto:ames
|
=, crypto:ames
|
||||||
|
=* womb womb:^jael
|
||||||
=, jael
|
=, jael
|
||||||
:: ::::
|
:: ::::
|
||||||
:::: # models :: data structures
|
:::: # models :: data structures
|
||||||
@ -444,7 +445,7 @@
|
|||||||
[n.b ~ ~]
|
[n.b ~ ~]
|
||||||
:: :: ++put:py
|
:: :: ++put:py
|
||||||
++ put :: insert
|
++ put :: insert
|
||||||
|= b/ship ^- pile
|
|= b/@ ^- pile
|
||||||
(uni [b b] ~ ~)
|
(uni [b b] ~ ~)
|
||||||
:: :: ++sub:py
|
:: :: ++sub:py
|
||||||
++ sub :: subtract
|
++ sub :: subtract
|
||||||
@ -467,10 +468,10 @@
|
|||||||
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
|
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
|
||||||
::
|
::
|
||||||
++ tap
|
++ tap
|
||||||
=| out/(list (pair ship ship))
|
=| out/(list @u)
|
||||||
|- ^+ out
|
|- ^+ out
|
||||||
?~ a 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:py
|
||||||
++ uni :: merge two piles
|
++ uni :: merge two piles
|
||||||
|= b/pile
|
|= b/pile
|
||||||
@ -518,7 +519,7 @@
|
|||||||
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
|
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
|
||||||
$block ?>(?=($block -.ryt) [~ ~])
|
$block ?>(?=($block -.ryt) [~ ~])
|
||||||
$email ?>(?=($email -.ryt) (sable %email p.lef p.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))
|
$fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt))
|
||||||
$guest ?>(?=($guest -.ryt) [~ ~])
|
$guest ?>(?=($guest -.ryt) [~ ~])
|
||||||
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
|
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
|
||||||
@ -528,6 +529,11 @@
|
|||||||
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
|
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
|
||||||
$urban ?>(?=($urban -.ryt) (table %urban 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:dif:ry
|
||||||
++ bible :: diff pile
|
++ bible :: diff pile
|
||||||
|* {nut/@tas new/(map dorm pile) old/(map dorm pile)}
|
|* {nut/@tas new/(map dorm pile) old/(map dorm pile)}
|
||||||
@ -623,7 +629,7 @@
|
|||||||
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
|
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
|
||||||
$block ?>(?=($block -.ryt) [%block ~])
|
$block ?>(?=($block -.ryt) [%block ~])
|
||||||
$email ?>(?=($email -.ryt) [%email (sable p.lef p.ryt)])
|
$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)])
|
$fungi ?>(?=($fungi -.ryt) [%fungi (noble p.lef p.ryt)])
|
||||||
$guest ?>(?=($guest -.ryt) [%guest ~])
|
$guest ?>(?=($guest -.ryt) [%guest ~])
|
||||||
$hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)])
|
$hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)])
|
||||||
@ -633,6 +639,11 @@
|
|||||||
$token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)])
|
$token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)])
|
||||||
$urban ?>(?=($urban -.ryt) [%urban (table 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:uni:ry
|
||||||
++ bible :: union pile
|
++ bible :: union pile
|
||||||
|= {new/(map dorm pile) old/(map dorm pile)}
|
|= {new/(map dorm pile) old/(map dorm pile)}
|
||||||
@ -699,7 +710,7 @@
|
|||||||
|= ryt/rite
|
|= ryt/rite
|
||||||
^- safe
|
^- safe
|
||||||
?~ pig
|
?~ pig
|
||||||
~
|
!! :: not found
|
||||||
?. =(-.ryt -.n.pig)
|
?. =(-.ryt -.n.pig)
|
||||||
?: (gor -.ryt -.n.pig)
|
?: (gor -.ryt -.n.pig)
|
||||||
[n.pig $(pig l.pig) r.pig]
|
[n.pig $(pig l.pig) r.pig]
|
||||||
@ -782,7 +793,7 @@
|
|||||||
[%apple (~(run by p.rys) |=(@ (mug +<)))]
|
[%apple (~(run by p.rys) |=(@ (mug +<)))]
|
||||||
::
|
::
|
||||||
$final
|
$final
|
||||||
[%final (~(run by p.rys) |=(@ (mug +<)))]
|
[%final (mug p.rys)]
|
||||||
::
|
::
|
||||||
$login
|
$login
|
||||||
[%login ~]
|
[%login ~]
|
||||||
@ -831,16 +842,16 @@
|
|||||||
|_ pub/will
|
|_ pub/will
|
||||||
:: :: ++collate:we
|
:: :: ++collate:we
|
||||||
++ collate :: sort by version
|
++ collate :: sort by version
|
||||||
|= com/$-({{life cert} {life cert}} ?)
|
|= ord/$-({{life cert} {life cert}} ?)
|
||||||
^- (list (pair life cert))
|
^- (list (pair life cert))
|
||||||
(sort (~(tap by pub)) com)
|
(sort (~(tap by pub)) ord)
|
||||||
:: :: ++current:we
|
:: :: ++current:we
|
||||||
++ current :: current number
|
++ current :: current number
|
||||||
^- (unit life)
|
^- (unit life)
|
||||||
(bind instant |=((pair life cert) p))
|
(bind instant |=((pair life cert) p))
|
||||||
:: :: ++forward:we
|
:: :: ++forward:we
|
||||||
++ forward :: sort oldest first
|
++ forward :: sort oldest first
|
||||||
(collate |=({a/{life *} b/{life *}} (lth -.a -.b)))
|
(collate |=({{a/life *} {b/life *}} (lth a b)))
|
||||||
:: :: ++instant:we
|
:: :: ++instant:we
|
||||||
++ instant :: current cert
|
++ instant :: current cert
|
||||||
^- (unit (pair life cert))
|
^- (unit (pair life cert))
|
||||||
@ -848,7 +859,7 @@
|
|||||||
?~(- ~ `i)
|
?~(- ~ `i)
|
||||||
:: :: ++reverse:we
|
:: :: ++reverse:we
|
||||||
++ reverse :: sort latest first
|
++ 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
|
++ burb :: per ship
|
||||||
|= who/ship
|
|= who/ship
|
||||||
~(able ~(ex ur urb) who)
|
~(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:of
|
||||||
++ call :: invoke
|
++ call :: invoke
|
||||||
|= $: :: hen: event cause
|
|= $: :: hen: event cause
|
||||||
@ -927,7 +965,9 @@
|
|||||||
:: {$init p/code q/arms}
|
:: {$init p/code q/arms}
|
||||||
::
|
::
|
||||||
$init
|
$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
|
:: create promises
|
||||||
:: {$mint p/ship q/safe}
|
:: {$mint p/ship q/safe}
|
||||||
@ -969,6 +1009,13 @@
|
|||||||
$next
|
$next
|
||||||
(cure abet:abet:(next:(burb our) eny.sys p.tac))
|
(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
|
:: open secure channel
|
||||||
:: {$veil p/ship}
|
:: {$veil p/ship}
|
||||||
::
|
::
|
||||||
@ -1463,6 +1510,8 @@
|
|||||||
:: it is the best reference for the semantics of
|
:: it is the best reference for the semantics of
|
||||||
:: the urbit pki.
|
:: the urbit pki.
|
||||||
::
|
::
|
||||||
|
=* our !!
|
||||||
|
::
|
||||||
:: it is absolutely verboten to use [our] in ++ur.
|
:: it is absolutely verboten to use [our] in ++ur.
|
||||||
::
|
::
|
||||||
=| hab/(list change)
|
=| hab/(list change)
|
||||||
@ -1505,73 +1554,6 @@
|
|||||||
|= rex/ship
|
|= rex/ship
|
||||||
^- (pair life (map life ring))
|
^- (pair life (map life ring))
|
||||||
lean:~(able ex rex)
|
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:ur
|
||||||
++ meet :: calculate merge
|
++ meet :: calculate merge
|
||||||
|= $: :: vie: authenticated source
|
|= $: :: vie: authenticated source
|
||||||
@ -1656,6 +1638,72 @@
|
|||||||
|= pal/ship
|
|= pal/ship
|
||||||
^- safe
|
^- safe
|
||||||
=-(?~(- ~ u.-) (~(get by shy) pal))
|
=-(?~(- ~ 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:ex:ur
|
||||||
++ next :: advance private key
|
++ next :: advance private key
|
||||||
|= {eny/@e doc/bull}
|
|= {eny/@e doc/bull}
|
||||||
@ -1678,6 +1726,140 @@
|
|||||||
=. +>.$ (deal rex [[ryt ~ ~] ~])
|
=. +>.$ (deal rex [[ryt ~ ~] ~])
|
||||||
=. ..ex (meet [~ ~] hec)
|
=. ..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:ex:ur
|
||||||
++ grow :: merge wills
|
++ grow :: merge wills
|
||||||
|= $: :: vie: data source
|
|= $: :: vie: data source
|
||||||
@ -1916,7 +2098,7 @@
|
|||||||
==
|
==
|
||||||
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task) p.q.hic)))
|
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task) p.q.hic)))
|
||||||
^- {p/(list move) q/_..^$}
|
^- {p/(list move) q/_..^$}
|
||||||
=^ did lex abet:~(call of [now eny] lex)
|
=^ did lex abet:(~(call of [now eny] lex) hen q.hic)
|
||||||
[did ..^$]
|
[did ..^$]
|
||||||
:: :: ++doze
|
:: :: ++doze
|
||||||
++ doze :: await
|
++ doze :: await
|
||||||
@ -1953,7 +2135,12 @@
|
|||||||
tyl/spur
|
tyl/spur
|
||||||
==
|
==
|
||||||
^- (unit (unit cage))
|
^- (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
|
||||||
++ stay :: preserve
|
++ stay :: preserve
|
||||||
lex
|
lex
|
||||||
|
|||||||
@ -922,22 +922,57 @@
|
|||||||
%+ each balance :: complete
|
%+ each balance :: complete
|
||||||
action :: change
|
action :: change
|
||||||
::
|
::
|
||||||
++ task :: in request ->$
|
++ task :: in request ->$
|
||||||
$% {$burn p/ship q/safe} :: destroy rights
|
$% {$burn p/ship q/safe} :: destroy rights
|
||||||
{$hail p/ship q/remote} :: remote update
|
{$hail p/ship q/remote} :: remote update
|
||||||
{$init p/@pG q/arms} :: initialize urbit
|
{$init p/@p}
|
||||||
{$meet p/(unit (unit ship)) q/farm} :: integrate pki from
|
:: {$init p/@pG q/arms} :: initialize urbit
|
||||||
{$mint p/ship q/safe} :: create rights
|
{$meet p/(unit (unit ship)) q/farm} :: integrate pki from
|
||||||
{$move p/ship q/ship r/safe} :: transfer from/to
|
{$mint p/ship q/safe} :: create rights
|
||||||
{$next p/bull} :: update private key
|
{$move p/ship q/ship r/safe} :: transfer from/to
|
||||||
{$nuke $~} :: cancel tracker from
|
{$next p/bull} :: update private key
|
||||||
{$veil p/ship} :: view secret channel
|
{$nuke $~} :: cancel tracker from
|
||||||
{$vein $~} :: view signing keys
|
{$veil p/ship} :: view secret channel
|
||||||
{$vest $~} :: view public balance
|
{$vein $~} :: view signing keys
|
||||||
{$vine $~} :: view secret history
|
{$vest $~} :: view public balance
|
||||||
{$west p/ship q/path r/*} :: remote request
|
{$vine $~} :: view secret history
|
||||||
== ::
|
{$jaelwomb p/task:womb}
|
||||||
-- :: moves
|
{$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
|
:::: ++pki:^jael :: (1h2) certificates
|
||||||
:: ::::
|
:: ::::
|
||||||
@ -1030,8 +1065,8 @@
|
|||||||
++ rite :: urbit commitment
|
++ rite :: urbit commitment
|
||||||
$% {$apple p/(map site @)} :: web api key
|
$% {$apple p/(map site @)} :: web api key
|
||||||
{$block $~} :: banned
|
{$block $~} :: banned
|
||||||
{$email p/(set @ta)} :: email addresses
|
{$email p/(set @t)} :: email addresses
|
||||||
{$final p/(map ship @pG)} :: ticketed ships
|
{$final p/@pG} :: recognize by ticket
|
||||||
{$fungi p/(map term @ud)} :: fungibles
|
{$fungi p/(map term @ud)} :: fungibles
|
||||||
{$guest $~} :: refugee visa
|
{$guest $~} :: refugee visa
|
||||||
{$hotel p/(map dorm pile)} :: reserved block
|
{$hotel p/(map dorm pile)} :: reserved block
|
||||||
@ -4516,6 +4551,7 @@
|
|||||||
{$e task:able:^eyre}
|
{$e task:able:^eyre}
|
||||||
{$f task:able:^ford}
|
{$f task:able:^ford}
|
||||||
{$g task:able:^gall}
|
{$g task:able:^gall}
|
||||||
|
{$j $init ship} :: XX actual jael tasks
|
||||||
== ==
|
== ==
|
||||||
++ sign-arvo :: in result $<-
|
++ sign-arvo :: in result $<-
|
||||||
$% {$a gift:able:^ames}
|
$% {$a gift:able:^ames}
|
||||||
|
|||||||
@ -8,9 +8,9 @@
|
|||||||
/+ womb
|
/+ womb
|
||||||
:- %say
|
:- %say
|
||||||
|= $: {now/@da eny/@uvJ bec/beak}
|
|= $: {now/@da eny/@uvJ bec/beak}
|
||||||
{{who/@t $~} ref/(unit (each ship mail:womb)) sta/@}
|
{{who/@t $~} sta/@}
|
||||||
==
|
==
|
||||||
:- %womb-invite
|
:- %womb-invite
|
||||||
^- {cord reference invite}:womb
|
^- {cord invite}:womb
|
||||||
=+ inv=(scot %uv (end 7 1 eny))
|
=+ 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"]]
|
||||||
|
|||||||
@ -28,6 +28,7 @@
|
|||||||
[%b %behn]
|
[%b %behn]
|
||||||
[%d %dill]
|
[%d %dill]
|
||||||
[%e %eyre]
|
[%e %eyre]
|
||||||
|
[%j %jael]
|
||||||
==
|
==
|
||||||
|- ^+ all
|
|- ^+ all
|
||||||
?~ vay all
|
?~ vay all
|
||||||
|
|||||||
@ -192,7 +192,7 @@
|
|||||||
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
|
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
|
||||||
=. cur-vanes
|
=. cur-vanes
|
||||||
%- malt
|
%- 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/@tas
|
||||||
:- syd
|
:- syd
|
||||||
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
|
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
|
||||||
@ -244,7 +244,7 @@
|
|||||||
|= {way/wire rot/riot}
|
|= {way/wire rot/riot}
|
||||||
?> ?=($~ way)
|
?> ?=($~ way)
|
||||||
?> ?=(^ rot)
|
?> ?=(^ rot)
|
||||||
=+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
|
=+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
|
||||||
=. +>.$
|
=. +>.$
|
||||||
?. autoload
|
?. autoload
|
||||||
+>.$
|
+>.$
|
||||||
|
|||||||
634
lib/womb.hoon
634
lib/womb.hoon
@ -5,49 +5,50 @@
|
|||||||
/+ talk, old-phon
|
/+ talk, old-phon
|
||||||
=, wired:eyre
|
=, wired:eyre
|
||||||
=, title:jael
|
=, title:jael
|
||||||
|
=, womb:^jael
|
||||||
:: :: ::
|
:: :: ::
|
||||||
:::: :: ::
|
:::: :: ::
|
||||||
:: :: ::
|
:: :: ::
|
||||||
|%
|
:: |%
|
||||||
++ foil :: ship allocation map
|
:: ++ foil :: ship allocation map
|
||||||
|* mold :: entry mold
|
:: |* mold :: entry mold
|
||||||
$: min/@u :: minimum entry
|
:: $: min/@u :: minimum entry
|
||||||
ctr/@u :: next allocated
|
:: ctr/@u :: next allocated
|
||||||
und/(set @u) :: free under counter
|
:: und/(set @u) :: free under counter
|
||||||
ove/(set @u) :: alloc over counter
|
:: ove/(set @u) :: alloc over counter
|
||||||
max/@u :: maximum entry
|
:: max/@u :: maximum entry
|
||||||
box/(map @u +<) :: entries
|
:: box/(map @u +<) :: entries
|
||||||
== ::
|
:: == ::
|
||||||
-- ::
|
:: -- ::
|
||||||
:: ::
|
:: ::
|
||||||
:::: ::
|
:::: ::
|
||||||
:: ::
|
:: ::
|
||||||
|% ::
|
|% ::
|
||||||
++ managed :: managed plot
|
:: ++ managed :: managed plot
|
||||||
|* mold ::
|
:: |* mold ::
|
||||||
%- unit :: unsplit
|
:: %- unit :: unsplit
|
||||||
%+ each +< :: subdivided
|
:: %+ each +< :: subdivided
|
||||||
mail :: delivered
|
:: mail :: delivered
|
||||||
:: ::
|
:: :: ::
|
||||||
++ divided :: get division state
|
:: ++ divided :: get division state
|
||||||
|* (managed) ::
|
:: |* (managed) ::
|
||||||
?- +< ::
|
:: ?- +< ::
|
||||||
$~ ~ :: unsplit
|
:: $~ ~ :: unsplit
|
||||||
{$~ $| *} ~ :: delivered
|
:: {$~ $| *} ~ :: delivered
|
||||||
{$~ $& *} (some p.u.+<) :: subdivided
|
:: {$~ $& *} (some p.u.+<) :: subdivided
|
||||||
== ::
|
:: == ::
|
||||||
:: ::
|
:: :: ::
|
||||||
++ moon (managed _!!) :: undivided moon
|
:: ++ moon (managed _!!) :: undivided moon
|
||||||
::
|
:: ::
|
||||||
++ planet :: subdivided planet
|
:: ++ planet :: subdivided planet
|
||||||
(managed (lone (foil moon))) ::
|
:: (managed (lone (foil moon))) ::
|
||||||
:: ::
|
:: :: ::
|
||||||
++ star :: subdivided star
|
:: ++ star :: subdivided star
|
||||||
(managed (pair (foil moon) (foil planet))) ::
|
:: (managed (pair (foil moon) (foil planet))) ::
|
||||||
:: ::
|
:: :: ::
|
||||||
++ galaxy :: subdivided galaxy
|
:: ++ galaxy :: subdivided galaxy
|
||||||
(managed (trel (foil moon) (foil planet) (foil star)))::
|
:: (managed (trel (foil moon) (foil planet) (foil star)))::
|
||||||
:: ::
|
:: :: ::
|
||||||
++ ticket @G :: old 64-bit ticket
|
++ ticket @G :: old 64-bit ticket
|
||||||
++ passcode @uvH :: 128-bit passcode
|
++ passcode @uvH :: 128-bit passcode
|
||||||
++ passhash @uwH :: passocde hash
|
++ passhash @uwH :: passocde hash
|
||||||
@ -58,15 +59,11 @@
|
|||||||
owner/mail :: owner's email
|
owner/mail :: owner's email
|
||||||
history/(list mail) :: transfer history
|
history/(list mail) :: transfer history
|
||||||
== ::
|
== ::
|
||||||
++ client :: per email
|
:: ++ property :: subdivided plots
|
||||||
$: sta/@ud :: unused star refs
|
:: $: galaxies/(map @p galaxy) :: galaxy
|
||||||
has/(set @p) :: planets owned
|
:: 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 ::
|
++ invite ::
|
||||||
$: who/mail :: who to send to
|
$: who/mail :: who to send to
|
||||||
pla/@ud :: planets to send
|
pla/@ud :: planets to send
|
||||||
@ -77,10 +74,6 @@
|
|||||||
$: intro/tape :: in invite email
|
$: intro/tape :: in invite email
|
||||||
hello/tape :: as talk message
|
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
|
++ stat (pair live dist) :: external info
|
||||||
++ live ?($cold $seen $live) :: online status
|
++ live ?($cold $seen $live) :: online status
|
||||||
++ dist :: allocation
|
++ dist :: allocation
|
||||||
@ -102,9 +95,8 @@
|
|||||||
++ part {$womb $1 pith} :: womb state
|
++ part {$womb $1 pith} :: womb state
|
||||||
++ pith :: womb content
|
++ pith :: womb content
|
||||||
$: boss/(unit ship) :: outside master
|
$: boss/(unit ship) :: outside master
|
||||||
bureau/(map passhash balance) :: active invitations
|
:: bureau/(map passhash balance) :: active invitations
|
||||||
office/property :: properties managed
|
:: office/property :: properties managed
|
||||||
hotel/(map (each ship mail) client) :: everyone we know
|
|
||||||
recycling/(map ship @) :: old ticket keys
|
recycling/(map ship @) :: old ticket keys
|
||||||
== ::
|
== ::
|
||||||
-- ::
|
-- ::
|
||||||
@ -112,6 +104,14 @@
|
|||||||
:::: :: ::
|
:::: :: ::
|
||||||
:: :: ::
|
:: :: ::
|
||||||
|% :: arvo structures
|
|% :: 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 ::
|
++ card ::
|
||||||
$% {$flog wire flog:^dill} ::
|
$% {$flog wire flog:^dill} ::
|
||||||
{$info wire @p @tas nori:^clay} :: fs write (backup)
|
{$info wire @p @tas nori:^clay} :: fs write (backup)
|
||||||
@ -120,7 +120,8 @@
|
|||||||
{$poke wire dock pear} :: app RPC
|
{$poke wire dock pear} :: app RPC
|
||||||
{$next wire p/ring} :: update private key
|
{$next wire p/ring} :: update private key
|
||||||
{$tick wire p/@pG q/@p} :: save ticket
|
{$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 ::
|
++ pear ::
|
||||||
$% {$email mail tape wall} :: send email
|
$% {$email mail tape wall} :: send email
|
||||||
@ -133,19 +134,17 @@
|
|||||||
{$womb-balance balance} ::
|
{$womb-balance balance} ::
|
||||||
{$womb-balance-all (map passhash mail)} ::
|
{$womb-balance-all (map passhash mail)} ::
|
||||||
{$womb-stat stat} ::
|
{$womb-stat stat} ::
|
||||||
{$womb-stat-all (map ship stat)} ::
|
:: {$womb-stat-all (map ship stat)} ::
|
||||||
{$womb-ticket-info passcode ?($fail $good $used)} ::
|
{$womb-ticket-info passcode ?($fail $good $used)} ::
|
||||||
==
|
==
|
||||||
++ move (pair bone card) :: user-level move
|
++ move (pair bone card) :: user-level move
|
||||||
::
|
::
|
||||||
++ transaction :: logged poke
|
++ transaction :: logged poke
|
||||||
$% {$report her/@p wyl/wyll:^ames}
|
$% {$report her/@p wyl/wyll:^ames}
|
||||||
{$release gal/@ud sta/@ud}
|
|
||||||
{$release-ships (list ship)}
|
|
||||||
{$claim aut/passcode her/@p}
|
{$claim aut/passcode her/@p}
|
||||||
{$recycle who/mail him/knot tik/knot}
|
{$recycle who/mail him/knot tik/knot}
|
||||||
{$bonus tid/cord pla/@ud sta/@ud}
|
{$bonus tid/cord pla/@ud sta/@ud}
|
||||||
{$invite tid/cord ref/reference inv/invite}
|
{$invite tid/cord inv/invite}
|
||||||
{$reinvite aut/passcode inv/invite}
|
{$reinvite aut/passcode inv/invite}
|
||||||
==
|
==
|
||||||
--
|
--
|
||||||
@ -170,86 +169,8 @@
|
|||||||
=+ d=(b q.c)
|
=+ d=(b q.c)
|
||||||
?~(d ~ (some [p.c u.d]))
|
?~(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
|
++ 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.+<)))
|
?~(+< +> $(+< 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
|
++ ames-last-seen :: last succesful ping
|
||||||
|= a/ship ~+ ^- (unit time)
|
|= a/ship ~+ ^- (unit time)
|
||||||
?: =(a our) (some now)
|
?: =(a our) (some now)
|
||||||
@ -306,113 +201,25 @@
|
|||||||
%+ ames-grab %rue
|
%+ ames-grab %rue
|
||||||
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
|
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
|
||||||
::
|
::
|
||||||
++ neighboured :: filter for connectivity
|
++ jael-scry
|
||||||
|* a/(list {ship *}) ^+ a
|
|* {typ/mold pax/path} ^- typ
|
||||||
%+ skim a
|
.^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax))
|
||||||
|= {b/ship *}
|
|
||||||
?=(^ (ames-last-seen b))
|
|
||||||
::
|
::
|
||||||
++ 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
|
++ peek-x-shop :: available ships
|
||||||
|= tyl/path ^- (unit (unit {$ships (list @p)}))
|
|= tyl/path ^- (unit (unit {$ships (list @p)}))
|
||||||
=; a ~& peek-x-shop+[tyl a] a
|
=; 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 ~))
|
:: XX redundant parse?
|
||||||
:: =. nth (mul 3 nth)
|
=+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud]))
|
||||||
?+ typ ~|(bad-type+typ !!)
|
(jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships)
|
||||||
$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-live :: last-heard time ++live
|
++ get-live :: last-heard time ++live
|
||||||
|= a/ship ^- live
|
|= a/ship ^- live
|
||||||
@ -420,88 +227,39 @@
|
|||||||
?~ rue %cold
|
?~ rue %cold
|
||||||
?:((gth (sub now u.rue) ~m5) %seen %live)
|
?:((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
|
++ stats-ship :: inspect ship
|
||||||
|= who/@p ^- stat
|
|= who/@p ^- stat
|
||||||
?- (clan who)
|
:- (get-live who)
|
||||||
$pawn !!
|
=/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner)
|
||||||
$earl !!
|
?~ man [%free ~]
|
||||||
$duke (stat-planet who (get-managed-planet who))
|
?: stat-no-email [%owned '']
|
||||||
$king (stat-star who (get-managed-star who))
|
[%owned u.man]
|
||||||
$czar (stat-galaxy who (get-managed-galaxy who))
|
|
||||||
==
|
|
||||||
::
|
::
|
||||||
++ peek-x-stats :: inspect ship/system
|
++ peek-x-stats :: inspect ship/system
|
||||||
|= tyl/path
|
|= tyl/path
|
||||||
?^ tyl
|
?^ tyl
|
||||||
?> |(=(our src) =([~ src] boss)) :: privileged info
|
?> |(=(our src) =([~ src] boss)) :: privileged info
|
||||||
``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
|
:: XX redundant parse?
|
||||||
^- (unit (unit {$womb-stat-all (map ship stat)}))
|
=+ who=~|(bad-path+tyl (raid tyl /[who=%p]))
|
||||||
=. stat-no-email & :: censor adresses
|
``womb-stat+(stats-ship who)
|
||||||
:^ ~ ~ %womb-stat-all
|
!! :: XX meaningful and/or useful in sein-jael model?
|
||||||
%- ~(uni by (~(urn by planets.office) stat-planet))
|
:: ^- (unit (unit {$womb-stat-all (map ship stat)}))
|
||||||
%- ~(uni by (~(urn by stars.office) stat-star))
|
:: =. stat-no-email & :: censor adresses
|
||||||
(~(urn by galaxies.office) stat-galaxy)
|
:: :^ ~ ~ %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
|
++ peek-x-balance :: inspect invitation
|
||||||
|= tyl/path
|
|= tyl/path
|
||||||
?~ tyl
|
|
||||||
?> |(=(our src) =([~ src] boss)) :: priveledged
|
|
||||||
``[%womb-balance-all (~(run by bureau) |=(balance owner))]
|
|
||||||
^- (unit (unit {$womb-balance balance}))
|
^- (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
|
%- some
|
||||||
%+ bind (~(get by bureau) (shaf %pass pas))
|
%+ bind (jael-pas-balance pas)
|
||||||
|=(bal/balance [%womb-balance bal])
|
|=(a/balance [%womb-balance a])
|
||||||
::
|
::
|
||||||
:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library
|
|
||||||
++ parse-ticket
|
++ parse-ticket
|
||||||
|= {a/knot b/knot} ^- {him/@ tik/@}
|
|= {a/knot b/knot} ^- {him/@ tik/@}
|
||||||
[him=(rash a old-phon) tik=(rash b old-phon)]
|
[him=(rash a old-phon) tik=(rash b old-phon)]
|
||||||
@ -524,7 +282,7 @@
|
|||||||
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
|
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
|
||||||
:- pas
|
:- pas
|
||||||
?. gud %fail
|
?. gud %fail
|
||||||
?: (~(has by bureau) (shaf %pass pas)) %used
|
?^ (jael-pas-balance pas) %used
|
||||||
%good
|
%good
|
||||||
::
|
::
|
||||||
++ peer-scry-x :: subscription like .^
|
++ peer-scry-x :: subscription like .^
|
||||||
@ -548,7 +306,6 @@
|
|||||||
:: /stats general stats dump
|
:: /stats general stats dump
|
||||||
:: /stats/@p what we know about @p
|
:: /stats/@p what we know about @p
|
||||||
$stats (peek-x-stats +.tyl)
|
$stats (peek-x-stats +.tyl)
|
||||||
:: /balance all invitations
|
|
||||||
:: /balance/passcode invitation status
|
:: /balance/passcode invitation status
|
||||||
$balance (peek-x-balance +.tyl)
|
$balance (peek-x-balance +.tyl)
|
||||||
:: /ticket/ship/ticket check ticket usability
|
:: /ticket/ship/ticket check ticket usability
|
||||||
@ -561,29 +318,6 @@
|
|||||||
?> |(=(our src) =([~ src] boss)) :: privileged
|
?> |(=(our src) =([~ src] boss)) :: privileged
|
||||||
.(recycling (~(put by recycling) a b))
|
.(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
|
++ email :: send email
|
||||||
|= {wir/wire adr/mail msg/tape} ^+ +>
|
|= {wir/wire adr/mail msg/tape} ^+ +>
|
||||||
?: replay +> :: dont's send email in replay mode
|
?: replay +> :: dont's send email in replay mode
|
||||||
@ -610,10 +344,8 @@
|
|||||||
$bonus (teba (poke-bonus +.pok.i.a))
|
$bonus (teba (poke-bonus +.pok.i.a))
|
||||||
$invite (teba (poke-invite +.pok.i.a))
|
$invite (teba (poke-invite +.pok.i.a))
|
||||||
$report (teba (poke-report +.pok.i.a))
|
$report (teba (poke-report +.pok.i.a))
|
||||||
$release (teba (poke-release +.pok.i.a))
|
|
||||||
$recycle (teba (poke-recycle +.pok.i.a))
|
$recycle (teba (poke-recycle +.pok.i.a))
|
||||||
$reinvite (teba (poke-reinvite +.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 +<)
|
=. log-transaction (log-transaction %bonus +<)
|
||||||
?> |(=(our src) =([~ src] boss)) :: priveledged
|
?> |(=(our src) =([~ src] boss)) :: priveledged
|
||||||
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
|
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
|
||||||
%_ .
|
(emit %jaelwomb / %bonus pas pla sta)
|
||||||
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))
|
|
||||||
==
|
|
||||||
::
|
::
|
||||||
++ poke-invite :: create invitation
|
++ poke-invite :: create invitation
|
||||||
|= {tid/cord ref/reference inv/invite}
|
|= {tid/cord inv/invite}
|
||||||
=< abet
|
=< abet
|
||||||
=. log-transaction (log-transaction %invite +<)
|
=. 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
|
?> |(=(our src) =([~ src] boss)) :: priveledged
|
||||||
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
|
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
|
||||||
?: (~(has by bureau) (shaf %pass pas))
|
=. emit (emit %jaelwomb / %invite pas [who pla sta]:inv)
|
||||||
~|([%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)
|
(email /invite who.inv intro.wel.inv)
|
||||||
::
|
::
|
||||||
:: ++ coup-invite :: invite sent
|
|
||||||
::
|
|
||||||
++ poke-reinvite :: split invitation
|
++ poke-reinvite :: split invitation
|
||||||
|= {aut/passcode inv/invite} :: further invite
|
|= {aut/passcode inv/invite} :: further invite
|
||||||
=< abet
|
=< abet
|
||||||
=. log-transaction (log-transaction %reinvite +<)
|
=. log-transaction (log-transaction %reinvite +<)
|
||||||
?> =(src src) :: self-authenticated
|
?> =(src src) :: self-authenticated
|
||||||
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
|
=/ pas/@uv (end 7 1 (shaf %pass eny))
|
||||||
=. stars.bal (sub stars.bal sta.inv)
|
=. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
|
||||||
=. planets.bal (sub planets.bal pla.inv)
|
(email /invite who.inv intro.wel.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)
|
|
||||||
::
|
::
|
||||||
++ poke-obey :: set/reset boss
|
++ poke-obey :: set/reset boss
|
||||||
|= who/(unit @p)
|
|= who/(unit @p)
|
||||||
@ -696,47 +406,6 @@
|
|||||||
?> =(src src) :: self-authenticated
|
?> =(src src) :: self-authenticated
|
||||||
(emit %knew /report her wyl)
|
(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
|
++ poke-recycle :: save ticket as balance
|
||||||
|= {who/mail him-t/knot tik-t/knot}
|
|= {who/mail him-t/knot tik-t/knot}
|
||||||
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
|
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
|
||||||
@ -746,10 +415,14 @@
|
|||||||
=+ [him tik]=(parse-ticket him-t tik-t)
|
=+ [him tik]=(parse-ticket him-t tik-t)
|
||||||
?> (need (check-old-ticket him tik))
|
?> (need (check-old-ticket him tik))
|
||||||
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
|
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
|
||||||
?: (~(has by bureau) (shaf %pass pas))
|
:: ?^ (scry-womb-invite (shaf %pass pas))
|
||||||
~|(already-recycled+[him-t tik-t] !!)
|
:: ~|(already-recycled+[him-t tik-t] !!)
|
||||||
=+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~])
|
=/ inv/{pla/@ud sta/@ud}
|
||||||
.(bureau (~(put by bureau) (shaf %pass pas) bal))
|
?+((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
|
++ poke-claim :: claim plot, req ticket
|
||||||
|= {aut/passcode her/@p}
|
|= {aut/passcode her/@p}
|
||||||
@ -757,100 +430,9 @@
|
|||||||
=< abet
|
=< abet
|
||||||
=. log-transaction (log-transaction %claim +<)
|
=. log-transaction (log-transaction %claim +<)
|
||||||
?> =(src src)
|
?> =(src src)
|
||||||
(claim-any aut her)
|
=/ bal ~|(%bad-invite (need (jael-pas-balance aut)))
|
||||||
::
|
=/ tik/ticket (end 6 1 (shas %tick eny))
|
||||||
++ claim-any :: register
|
=. emit (emit %jaelwomb / %claim aut her tik)
|
||||||
|= {aut/passcode her/@p}
|
:: XX event crashes work properly yes?
|
||||||
=; claimed
|
(email /ticket owner.bal "Ticket for {<her>}: {<`@pG`tik>}")
|
||||||
:: =. 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))
|
|
||||||
--
|
--
|
||||||
|
|||||||
@ -1,11 +0,0 @@
|
|||||||
::
|
|
||||||
:::: /hoon/do-claim/womb/mar
|
|
||||||
::
|
|
||||||
/? 310
|
|
||||||
|_ {her/ship tik/@p}
|
|
||||||
::
|
|
||||||
++ grab :: convert from
|
|
||||||
|%
|
|
||||||
++ noun {ship @p} :: clam from %noun
|
|
||||||
--
|
|
||||||
--
|
|
||||||
@ -1,11 +0,0 @@
|
|||||||
::
|
|
||||||
:::: /hoon/do-ticket/womb/mar
|
|
||||||
::
|
|
||||||
/? 310
|
|
||||||
|_ her/ship
|
|
||||||
::
|
|
||||||
++ grab :: convert from
|
|
||||||
|%
|
|
||||||
++ noun @p :: clam from %noun
|
|
||||||
--
|
|
||||||
--
|
|
||||||
@ -6,11 +6,11 @@
|
|||||||
::
|
::
|
||||||
:::: ~fyr
|
:::: ~fyr
|
||||||
::
|
::
|
||||||
|_ {cord reference invite}:womb
|
|_ {cord invite}:womb
|
||||||
::
|
::
|
||||||
++ grab :: convert from
|
++ grab :: convert from
|
||||||
|%
|
|%
|
||||||
++ noun {cord reference invite}:womb :: clam from %noun
|
++ noun {cord invite}:womb :: clam from %noun
|
||||||
++ json
|
++ json
|
||||||
%+ corl need
|
%+ corl need
|
||||||
=> jo
|
=> jo
|
||||||
@ -21,7 +21,6 @@
|
|||||||
==
|
==
|
||||||
%- ot :~
|
%- ot :~
|
||||||
tid+so
|
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 ~) ~)
|
inv+(ot who+(su mail) pla+ni sta+ni wel+(ot intro+sa hello+sa ~) ~)
|
||||||
==
|
==
|
||||||
--
|
--
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user