shrub/lib/womb.hoon

822 lines
32 KiB
Plaintext
Raw Normal View History

2016-04-08 20:08:05 +03:00
:: :: ::
:::: /hoon/womb/lib :: ::
:: :: ::
/? 310 :: version
/+ talk, old-phon
2016-04-08 20:08:05 +03:00
:: :: ::
:::: :: ::
:: :: ::
|%
2016-04-12 22:02:59 +03:00
++ foil :: ship allocation map
2016-04-08 20:08:05 +03:00
|* mold :: entry mold
2016-04-13 01:42:49 +03:00
$: 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
2016-04-08 20:08:05 +03:00
== ::
-- ::
:: ::
:::: ::
:: ::
2016-04-08 20:08:05 +03:00
|% ::
++ managed :: managed plot
2016-07-06 09:57:25 +03:00
|* mold ::
2016-04-12 22:02:59 +03:00
%- unit :: unsplit
2016-04-08 20:08:05 +03:00
%+ each +< :: subdivided
mail :: delivered
:: ::
2016-04-14 00:06:58 +03:00
++ divided :: get division state
|* (managed) ::
?- +< ::
$~ ~ :: unsplit
{$~ $| *} ~ :: delivered
{$~ $& *} (some p.u.+<) :: subdivided
== ::
:: ::
2016-04-12 22:02:59 +03:00
++ moon (managed _!!) :: undivided moon
::
2016-04-08 20:08:05 +03:00
++ 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
2016-07-07 00:49:46 +03:00
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
2016-04-30 02:18:59 +03:00
++ mail @t :: email address
2016-04-08 20:08:05 +03:00
++ balance :: invitation balance
$: planets/@ud :: planet count
stars/@ud :: star count
owner/mail :: owner's email
history/(list mail) :: transfer history
== ::
++ client :: per email
$: sta/@ud :: unused star refs
has/(set @p) :: planets owned
== ::
2016-04-13 00:07:02 +03:00
++ property :: subdivided plots
$: galaxies/(map @p galaxy) :: galaxy
planets/(map @p planet) :: star
stars/(map @p star) :: planet
2016-04-08 20:08:05 +03:00
== ::
++ invite ::
$: who/mail :: who to send to
pla/@ud :: planets to send
sta/@ud :: stars to send
wel/welcome :: welcome message
== ::
++ welcome :: welcome message
$: intro/tape :: in invite email
hello/tape :: as talk message
== ::
++ reference :: affiliate credit
(unit (each @p mail)) :: ship or email
2016-04-14 01:03:05 +03:00
:: ::
2016-04-15 02:37:13 +03:00
++ reference-rate 2 :: star refs per star
++ stat (pair live dist) :: external info
++ live ?($cold $seen $live) :: online status
++ dist :: allocation
2016-04-14 01:03:05 +03:00
$% {$free $~} :: unallocated
{$owned p/mail} :: granted, status
{$split p/(map ship stat)} :: all given ships
2016-04-14 01:03:05 +03:00
== ::
:: ::
++ ames-tell :: .^ a+/=tell= type
|^ {p/(list elem) q/(list elem)} ::
++ elem $^ {p/elem q/elem} ::
{term p/*} :: somewhat underspecified
-- ::
2016-04-08 20:08:05 +03:00
-- ::
:: :: ::
:::: :: ::
:: :: ::
|%
++ part {$womb $1 pith} :: womb state
2016-04-13 03:10:53 +03:00
++ pith :: womb content
$: boss/(unit ship) :: outside master
2016-07-07 00:49:46 +03:00
bureau/(map passhash balance) :: active invitations
2016-04-13 00:07:02 +03:00
office/property :: properties managed
hotel/(map (each ship mail) client) :: everyone we know
2016-07-06 09:57:25 +03:00
recycling/(map ship @) :: old ticket keys
2016-04-08 20:08:05 +03:00
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|% :: arvo structures
++ card ::
$% {$flog wire flog} ::
2016-04-19 01:15:35 +03:00
{$info wire @p @tas nori} :: fs write (backup)
2016-04-15 00:37:16 +03:00
:: {$wait $~} :: delay acknowledgment
2016-04-27 00:29:07 +03:00
{$diff gilt} :: subscription response
2016-04-30 02:18:59 +03:00
{$poke wire dock pear} :: app RPC
2016-04-15 00:37:16 +03:00
{$next wire p/ring} :: update private key
{$tick wire p/@pG q/@p} :: save ticket
{$knew wire p/ship q/will} :: learn will (old pki)
2016-04-08 20:08:05 +03:00
== ::
2016-04-15 04:36:48 +03:00
++ pear ::
$% {$email mail tape wall} :: send email
{$womb-do-ticket ship} :: request ticket
{$womb-do-claim ship @p} :: issue ship
2016-07-06 09:57:25 +03:00
{$drum-put path @t} :: log transaction
2016-04-15 04:36:48 +03:00
== ::
2016-04-27 00:29:07 +03:00
++ gilt :: scry result
$% {$ships (list ship)} ::
{$womb-balance balance} ::
2016-07-07 00:49:46 +03:00
{$womb-balance-all (map passhash mail)} ::
2016-04-27 00:29:07 +03:00
{$womb-stat stat} ::
{$womb-stat-all (map ship stat)} ::
{$womb-ticket-info passcode ?($fail $good $used)} ::
2016-04-27 00:29:07 +03:00
==
2016-04-08 20:08:05 +03:00
++ move (pair bone card) :: user-level move
2016-04-30 02:18:59 +03:00
::
++ transaction :: logged poke
$% {$report her/@p wyl/will}
{$release gal/@ud sta/@ud}
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
2016-05-07 01:11:58 +03:00
{$invite tid/cord ref/reference inv/invite}
2016-04-30 02:18:59 +03:00
{$reinvite aut/passcode inv/invite}
==
2016-04-08 20:08:05 +03:00
--
2016-04-12 22:02:59 +03:00
|%
++ ames-grab :: XX better ames scry
|= {a/term b/ames-tell} ^- *
=; all (~(got by all) a)
%- ~(gas by *(map term *))
%- zing
%+ turn (weld p.b q.b)
|= b/elem:ames-tell ^- (list {term *})
?@ -.b [b]~
(weld $(b p.b) $(b q.b))
::
2016-04-12 22:02:59 +03:00
++ murn-by
|* {a/(map) b/$-(* (unit))}
^- ?~(a !! (map _p.n.a _(need (b q.n.a))))
%- malt
%+ murn (~(tap by a))
?~ a $~
|= _c=n.a ^- (unit _[p.n.a (need (b q.n.a))])
=+ 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))
2016-04-13 01:42:49 +03:00
^- (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])
2016-04-13 00:54:50 +03:00
++ cursor (pair (unit ship) @u)
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
2016-04-13 01:59:26 +03:00
::
:: Create new foil of size
2016-04-13 00:54:50 +03:00
++ fo-init
2016-04-13 01:42:49 +03:00
|= a/bloq :: ^- (foil *)
[min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
2016-04-13 00:54:50 +03:00
::
2016-04-12 22:02:59 +03:00
++ fo
2016-04-14 02:16:23 +03:00
|_ (foil $@($~ *))
++ nth :: index
2016-04-13 01:42:49 +03:00
|= a/@u ^- (pair (unit @u) @u)
2016-04-12 22:02:59 +03:00
?: (lth a ~(wyt in und))
=+ out=(snag a (sort (~(tap in und)) lth))
[(some out) 0]
=. a (sub a ~(wyt in und))
2016-04-13 01:42:49 +03:00
|- ^- {(unit @u) @u}
2016-04-12 22:02:59 +03:00
?: =(ctr +(max)) [~ a]
?: =(0 a) [(some ctr) a]
2016-04-14 02:16:23 +03:00
$(a (dec a), +<.nth new)
2016-04-12 22:02:59 +03:00
::
2016-04-13 00:54:50 +03:00
+- fin +< :: abet
2016-04-12 22:02:59 +03:00
++ new :: alloc
?: =(ctr +(max)) +<
=. ctr +(ctr)
?. (~(has in ove) ctr) +<
new(ove (~(del in ove) ctr))
::
2016-04-14 02:16:23 +03:00
+- get :: nullable
|= a/@p ^+ ?~(box ~ q.n.box)
(fall (~(get by box) (neis a)) ~)
::
2016-04-13 00:54:50 +03:00
+- put
2016-04-13 01:42:49 +03:00
|* {a/@u b/*} ^+ fin :: b/_(~(got by box))
~| put+[a fin]
2016-04-13 00:54:50 +03:00
?> (fit a)
=; adj adj(box (~(put by box) a b))
?: (~(has in box) a) fin
2016-07-06 09:57:25 +03:00
?: =(ctr a) new
2016-04-13 00:54:50 +03:00
?: (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))
::
2016-04-13 01:42:49 +03:00
++ fit |=(a/@u &((lte min a) (lte a max))) :: in range
2016-04-12 22:02:59 +03:00
++ gud :: invariant
?& (fit(max +(max)) ctr)
(~(all in und) fit(max ctr))
(~(all in ove) fit(min ctr))
2016-04-13 01:42:49 +03:00
(~(all in box) |=({a/@u *} (fit a)))
2016-04-12 22:02:59 +03:00
|- ^- ?
?: =(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)
==
==
--
--
2016-04-08 20:08:05 +03:00
:: :: ::
:::: :: ::
!: :: ::
=+ cfg=[can-claim=| can-recycle=|] :: temporarily disabled
=+ [replay=| stat-no-email=|] :: XX globals
2016-04-13 03:10:53 +03:00
|= {bowl part} :: main womb work
2016-04-08 20:08:05 +03:00
|_ moz/(list move)
++ abet :: resolve
2016-04-13 03:10:53 +03:00
^- (quip move *part)
2016-04-13 00:07:02 +03:00
[(flop moz) +>+<+]
2016-04-08 20:08:05 +03:00
::
2016-04-30 02:18:59 +03:00
++ teba :: install resolved
|= a/(quip move *part) ^+ +>
+>(moz (flop -.a), +>+<+ +.a)
::
2016-04-08 20:08:05 +03:00
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
2016-07-06 09:57:25 +03:00
|= (list card)
2016-04-08 20:08:05 +03:00
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ take-n :: compute range
2016-04-13 00:07:50 +03:00
|= {{index/@u count/@u} get/$-(@u cursor)}
2016-04-12 22:02:59 +03:00
^- (list ship)
2016-04-13 00:07:50 +03:00
?~ count ~
%+ biff p:(get index)
|= a/ship ^- (list ship)
[a ^$(index +(index), count (dec count))]
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ available :: enumerate free ships
2016-04-12 22:02:59 +03:00
|= 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]))
::
2016-04-14 00:06:58 +03:00
:: foil cursor to ship cursor, using sized parent
2016-04-13 01:42:49 +03:00
++ prefix
|= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor
?~ c [c d]
[(some (rep a b u.c ~)) d]
::
2016-04-14 00:06:58 +03:00
++ in-list :: distribute among options
2016-04-13 01:59:36 +03:00
|* {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)
%- (hard (unit time))
~| ames-look+/(scot %p our)/tell/(scot %da now)/(scot %p a)
%+ ames-grab %rue
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
2016-04-14 00:06:58 +03:00
::
++ neighboured :: filter for connectivity
|* a/(list {ship *}) ^+ a
%+ skim a
|= {b/ship *}
?=(^ (ames-last-seen b))
::
2016-04-14 00:06:58 +03:00
++ shop-galaxies (available galaxies.office) :: unassigned %czar
::
:: Stars can be either whole or children of galaxies
++ shop-stars :: unassigned %king
|= nth/@u ^- cursor
=^ out nth %.(nth (available stars.office))
?^ out [out nth]
2016-07-06 09:57:25 +03:00
%+ shop-star nth
(neighboured (issuing galaxies.office))
2016-04-14 00:06:58 +03:00
::
++ shop-star :: star from galaxies
2016-04-13 01:42:49 +03:00
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
2016-04-13 01:59:36 +03:00
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
2016-04-14 02:16:23 +03:00
(prefix 3 who.sel (~(nth fo r.sel) nth))
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ shop-planets :: unassigned %duke
2016-04-12 22:02:59 +03:00
|= nth/@u ^- cursor
2016-04-13 00:07:02 +03:00
=^ out nth %.(nth (available planets.office))
2016-04-12 22:02:59 +03:00
?^ out [out nth]
=^ out nth
2016-07-06 09:57:25 +03:00
%+ shop-planet nth
(neighboured (issuing stars.office))
2016-04-12 22:02:59 +03:00
?^ out [out nth]
2016-04-13 00:07:02 +03:00
(shop-planet-gal nth (issuing galaxies.office))
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ shop-planet :: planet from stars
2016-04-13 01:59:36 +03:00
|= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor
?: =(~ sta) [~ nth]
=^ sel nth (in-list sta nth)
2016-04-14 02:16:23 +03:00
(prefix 4 who.sel (~(nth fo q.sel) nth))
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ shop-planet-gal :: planet from galaxies
2016-04-13 01:42:49 +03:00
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
2016-04-13 01:59:36 +03:00
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
2016-07-06 09:57:25 +03:00
%+ shop-planet nth
(neighboured (issuing-under 3 who.sel box.r.sel))
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ peek-x-shop :: available ships
2016-04-12 22:02:59 +03:00
|= tyl/path ^- (unit (unit {$ships (list @p)}))
2016-04-13 03:10:53 +03:00
=; a ~& peek-x-shop+[tyl a] a
2016-04-12 22:02:59 +03:00
=; res (some (some [%ships res]))
2016-04-13 03:10:53 +03:00
=+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
2016-04-13 00:07:50 +03:00
:: =. nth (mul 3 nth)
?+ typ ~|(bad-type+typ !!)
2016-04-13 03:10:53 +03:00
$galaxies (take-n [nth 3] shop-galaxies)
$planets (take-n [nth 3] shop-planets)
$stars (take-n [nth 3] shop-stars)
2016-04-12 22:02:59 +03:00
==
::
2016-04-14 00:06:58 +03:00
++ get-managed-galaxy ~(got by galaxies.office) :: office read
++ mod-managed-galaxy :: office write
2016-04-13 23:32:45 +03:00
|= {who/@p mod/$-(galaxy galaxy)} ^+ +>
=+ gal=(mod (get-managed-galaxy who))
+>.$(galaxies.office (~(put by galaxies.office) who gal))
::
2016-04-14 00:06:58 +03:00
++ get-managed-star :: office read
2016-04-13 23:32:45 +03:00
|= who/@p ^- star
=+ (~(get by stars.office) who)
?^ - u
=+ gal=(get-managed-galaxy (sein who))
2016-04-14 23:49:39 +03:00
?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!)
2016-04-13 23:32:45 +03:00
(fall (~(get by box.r.p.u.gal) (neis who)) ~)
::
2016-04-14 00:06:58 +03:00
++ mod-managed-star :: office write
2016-04-13 23:32:45 +03:00
|= {who/@p mod/$-(star star)} ^+ +>
2016-04-14 00:06:58 +03:00
=+ sta=(mod (get-managed-star who)) :: XX double traverse
2016-04-13 23:32:45 +03:00
?: (~(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))
::
2016-04-14 00:06:58 +03:00
++ get-managed-planet :: office read
2016-04-13 23:32:45 +03:00
|= who/@p ^- planet
=+ (~(get by planets.office) who)
?^ - u
2016-07-06 09:57:25 +03:00
?: (~(has by galaxies.office) (sein who))
2016-04-13 23:32:45 +03:00
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!)
2016-04-14 02:16:23 +03:00
(~(get fo q.p.u.gal) who)
2016-04-13 23:32:45 +03:00
=+ sta=(get-managed-star (sein who))
?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!)
2016-04-14 02:16:23 +03:00
(~(get fo q.p.u.sta) who)
2016-04-13 23:32:45 +03:00
::
2016-04-14 00:06:58 +03:00
++ mod-managed-planet :: office write
2016-04-13 23:32:45 +03:00
|= {who/@p mod/$-(planet planet)} ^+ +>
2016-04-14 00:06:58 +03:00
=+ pla=(mod (get-managed-planet who)) :: XX double traverse
2016-04-13 23:32:45 +03:00
?: (~(has by planets.office) who)
+>.$(planets.office (~(put by planets.office) who pla))
2016-07-06 09:57:25 +03:00
?: (~(has by galaxies.office) (sein who))
2016-04-13 23:32:45 +03:00
%+ 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))
::
2016-04-28 01:38:01 +03:00
++ get-live :: last-heard time ++live
|= a/ship ^- live
=+ rue=(ames-last-seen a)
2016-07-06 09:57:25 +03:00
?~ rue %cold
?:((gth (sub now u.rue) ~m5) %seen %live)
::
2016-04-28 01:38:01 +03:00
++ stat-any :: unsplit status
|= {who/@p man/(managed _!!)} ^- stat
:- (get-live who)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned p.u.man]
::
2016-04-28 01:38:01 +03:00
++ stat-planet :: stat of planet
2016-04-14 01:03:05 +03:00
|= {who/@p man/planet} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
2016-04-14 01:03:05 +03:00
=+ pla=u:(divided man)
:- %split
%- malt
%+ turn (~(tap by box.p.pla))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
2016-04-14 01:03:05 +03:00
::
2016-04-28 01:38:01 +03:00
++ stat-star :: stat of star
2016-04-14 01:03:05 +03:00
|= {who/@p man/star} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
2016-04-14 01:03:05 +03:00
=+ sta=u:(divided man)
:- %split
%- malt
%+ welp
%+ turn (~(tap by box.p.sta))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
2016-04-14 01:03:05 +03:00
%+ turn (~(tap by box.q.sta))
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
2016-04-28 01:38:01 +03:00
++ stat-galaxy :: stat of galaxy
2016-04-14 01:03:05 +03:00
|= {who/@p man/galaxy} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
2016-04-14 01:03:05 +03:00
=+ gal=u:(divided man)
:- (get-live who)
2016-04-14 01:03:05 +03:00
:- %split
%- malt
;: welp
%+ turn (~(tap by box.p.gal))
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
2016-04-14 01:03:05 +03:00
::
%+ 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)]))
==
::
2016-04-14 00:06:58 +03:00
++ stats-ship :: inspect ship
|= who/@p ^- stat
2016-04-14 01:03:05 +03:00
?- (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))
2016-04-14 01:03:05 +03:00
==
2016-04-12 22:02:59 +03:00
::
2016-04-14 00:06:58 +03:00
++ peek-x-stats :: inspect ship/system
2016-04-12 22:02:59 +03:00
|= tyl/path
?^ tyl
?> |(=(our src) =([~ src] boss)) :: privileged info
``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
2016-04-14 01:03:05 +03:00
^- (unit (unit {$womb-stat-all (map ship stat)}))
=. stat-no-email & :: censor adresses
2016-04-14 01:03:05 +03:00
:^ ~ ~ %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)
2016-04-12 22:02:59 +03:00
::
++ peek-x-balance :: inspect invitation
2016-04-30 00:22:25 +03:00
|= 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 ~))
2016-04-12 22:02:59 +03:00
%- some
2016-07-07 00:49:46 +03:00
%+ bind (~(get by bureau) (shaf %pass pas))
2016-04-12 22:02:59 +03:00
|=(bal/balance [%womb-balance bal])
::
:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library
2016-05-04 20:58:35 +03:00
++ parse-ticket
|= {a/knot b/knot} ^- {him/@ tik/@}
[him=(rash a old-phon) tik=(rash b old-phon)]
::
++ check-old-ticket
|= {a/ship b/@pG} ^- (unit ?)
%+ bind (~(get by recycling) (sein a))
|= key/@ ^- ?
=(b `@p`(end 6 1 (shaf %tick (mix a (shax key)))))
2016-05-04 20:58:35 +03:00
::
::
2016-07-06 09:57:25 +03:00
++ peek-x-ticket
2016-05-04 20:58:35 +03:00
|= tyl/path
^- (unit (unit {$womb-ticket-info passcode ?($fail $good $used)}))
2016-05-04 20:58:35 +03:00
?. ?=({@ @ $~} tyl) ~|(bad-path+tyl !!)
=+ [him tik]=(parse-ticket i.tyl i.t.tyl)
%+ bind (check-old-ticket him tik)
|= gud/?
:+ ~ %womb-ticket-info
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:- pas
?. gud %fail
2016-07-07 00:49:46 +03:00
?: (~(has by bureau) (shaf %pass pas)) %used
%good
2016-05-04 20:58:35 +03:00
::
2016-04-28 01:38:01 +03:00
++ peer-scry-x :: subscription like .^
2016-04-27 00:29:07 +03:00
|= tyl/path
=< abet
=+ gil=(peek-x tyl)
~| tyl
?~ gil ~|(%block-stub !!)
?~ u.gil ~|(%bad-path !!)
(emit %diff u.u.gil)
::
2016-04-28 01:38:01 +03:00
++ peek-x :: stateless read
2016-04-27 00:29:07 +03:00
|= tyl/path ^- (unit (unit gilt))
~| peek+x+tyl
2016-04-12 22:02:59 +03:00
?~ tyl ~
?+ -.tyl ~
2016-04-13 03:10:53 +03:00
:: /shop/planets/@ud (list @p) up to 3 planets
:: /shop/stars/@ud (list @p) up to 3 stars
2016-07-06 09:57:25 +03:00
:: /shop/galaxies/@ud (list @p) up to 3 galaxies
2016-04-12 22:02:59 +03:00
$shop (peek-x-shop +.tyl)
2016-04-08 20:08:05 +03:00
:: /stats general stats dump
:: /stats/@p what we know about @p
2016-04-12 22:02:59 +03:00
$stats (peek-x-stats +.tyl)
2016-04-30 00:22:25 +03:00
:: /balance all invitations
2016-07-06 09:57:25 +03:00
:: /balance/passcode invitation status
$balance (peek-x-balance +.tyl)
2016-05-04 20:58:35 +03:00
:: /ticket/ship/ticket check ticket usability
$ticket (peek-x-ticket +.tyl)
2016-04-12 22:02:59 +03:00
==
2016-04-08 20:08:05 +03:00
::
++ poke-manage-old-key :: add to recyclable tickets
|= {a/ship b/@}
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
.(recycling (~(put by recycling) a b))
::
2016-04-15 02:52:37 +03:00
++ poke-manage :: add to property
|= a/(list ship)
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
|-
?~ a .
?+ (clan i.a) ~|(bad-size+(clan i.a) !!)
$duke
2016-08-10 23:55:16 +03:00
?. (~(has by planets.office) i.a)
$(a t.a, planets.office (~(put by planets.office) i.a ~))
2016-04-15 02:52:37 +03:00
~|(already-managing+i.a !!)
::
$king
2016-08-10 23:55:16 +03:00
?. (~(has by stars.office) i.a)
$(a t.a, stars.office (~(put by stars.office) i.a ~))
2016-04-15 02:52:37 +03:00
~|(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 !!)
==
::
2016-04-28 01:38:01 +03:00
++ email :: send email
2016-04-15 04:36:48 +03:00
|= {wir/wire adr/mail msg/tape} ^+ +>
2016-04-30 02:18:59 +03:00
?: replay +> :: dont's send email in replay mode
~& do-email+[adr msg]
::~&([%email-stub adr msg] +>)
(emit %poke [%mail wir] [our %gmail] %email adr "Your Urbit Invitation" [msg]~)
2016-04-14 23:49:39 +03:00
::
2016-04-30 02:18:59 +03:00
++ log-transaction :: logged poke
|= a/transaction ^+ +>
?: replay +>
(emit %poke /log [our %hood] %drum-put /womb-events/(scot %da now)/hoon (crip <eny a>))
::
++ poke-replay-log :: rerun transactions
|= a/(list {eny/@uvI pok/transaction})
?~ a abet
2016-05-02 23:03:33 +03:00
~& womb-replay+-.pok.i.a
2016-04-30 02:18:59 +03:00
=. eny eny.i.a
2016-05-02 23:03:33 +03:00
=. replay &
2016-04-30 02:18:59 +03:00
%_ $
a t.a
+>
?- -.pok.i.a
$claim (teba (poke-claim +.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))
2016-04-30 02:18:59 +03:00
$reinvite (teba (poke-reinvite +.pok.i.a))
==
==
::
2016-04-08 20:08:05 +03:00
++ poke-invite :: create invitation
2016-05-07 01:11:58 +03:00
|= {tid/cord ref/reference inv/invite}
2016-04-08 20:08:05 +03:00
=< abet
2016-04-30 02:18:59 +03:00
=. log-transaction (log-transaction %invite +<)
2016-04-15 02:37:13 +03:00
=. hotel
?~ ref hotel
?~ sta.inv hotel
%+ ~(put by hotel) u.ref
=+ cli=(fall (~(get by hotel) u.ref) *client)
cli(sta +(sta.cli))
2016-07-05 21:38:44 +03:00
(invite-from ~ tid inv)
2016-04-14 23:49:39 +03:00
::
2016-04-15 02:37:13 +03:00
++ invite-from :: traced invitation
2016-07-05 21:38:44 +03:00
|= {hiz/(list mail) tid/cord inv/invite} ^+ +>
2016-04-15 03:04:19 +03:00
?> |(=(our src) =([~ src] boss)) :: priveledged
2016-07-05 23:18:08 +03:00
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
2016-07-07 00:49:46 +03:00
?: (~(has by bureau) (shaf %pass pas))
2016-04-30 02:18:59 +03:00
~|([%duplicate-passcode pas who.inv replay=replay] !!)
2016-07-07 00:49:46 +03:00
=. bureau (~(put by bureau) (shaf %pass pas) [pla.inv sta.inv who.inv hiz])
2016-07-07 02:06:29 +03:00
(email /invite who.inv intro.wel.inv)
2016-04-14 23:49:39 +03:00
::
:: ++ coup-invite :: invite sent
::
++ poke-reinvite :: split invitation
|= {aut/passcode inv/invite} :: further invite
=< abet
2016-04-30 02:18:59 +03:00
=. log-transaction (log-transaction %reinvite +<)
?> =(src src) :: self-authenticated
2016-07-07 00:49:46 +03:00
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
2016-04-14 23:49:39 +03:00
=. stars.bal (sub stars.bal sta.inv)
=. planets.bal (sub planets.bal pla.inv)
2016-07-07 00:49:46 +03:00
=. bureau (~(put by bureau) (shaf %pass aut) bal)
=+ tid=(scot %uv (end 7 1 (shaf %pass eny)))
2016-07-05 21:38:44 +03:00
(invite-from [owner.bal history.bal] tid inv)
2016-04-08 20:08:05 +03:00
::
++ poke-obey :: set/reset boss
|= who/(unit @p)
=< abet
?> =(our src) :: me only
2016-04-15 00:37:16 +03:00
.(boss who)
2016-04-08 20:08:05 +03:00
::
2016-04-19 01:15:35 +03:00
++ poke-save :: write backup
|= pax/path
=< abet
2016-05-07 00:26:13 +03:00
?> =(our src) :: me only
2016-07-01 20:44:35 +03:00
=+ pas=`@uw`(shas %back eny)
~& [%backing-up pas=pas]
=; dif (emit %info /backup [our dif])
%+ foal (welp pax /jam-crub)
[%jam-crub !>((en:crub pas (jam `part`+:abet)))]
2016-04-19 01:15:35 +03:00
::
2016-04-08 20:08:05 +03:00
++ poke-rekey :: extend will
2016-04-12 22:02:59 +03:00
|= $~
2016-04-08 20:08:05 +03:00
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
2016-04-15 00:37:16 +03:00
:: (emit /rekey %next sec:ex:(brew 128 (shas %next eny)))
~&(rekey-stub+sec:ex:(brew 128 (shas %next eny)) .)
2016-04-08 20:08:05 +03:00
::
++ poke-report :: report will
|= {her/@p wyl/will} ::
=< abet
2016-04-30 02:18:59 +03:00
=. log-transaction (log-transaction %report +<)
2016-04-08 20:08:05 +03:00
?> =(src src) :: self-authenticated
2016-04-15 00:37:16 +03:00
(emit %knew /report her wyl)
2016-04-08 20:08:05 +03:00
::
2016-04-28 01:38:01 +03:00
++ use-reference :: bonus stars
2016-04-15 02:37:13 +03:00
|= 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
2016-04-15 03:04:19 +03:00
=< 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)
2016-08-05 23:17:01 +03:00
(emit %poke /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)
2016-08-05 23:17:01 +03:00
?> ?=($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?
==
2016-04-15 03:04:19 +03:00
::
++ poke-recycle :: save ticket as balance
|= {who/mail him-t/knot tik-t/knot}
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
2016-05-04 20:58:35 +03:00
=< abet
=. log-transaction (log-transaction %recycle +<)
2016-05-04 20:58:35 +03:00
?> =(src src)
=+ [him tik]=(parse-ticket him-t tik-t)
?> (need (check-old-ticket him tik))
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
2016-07-07 00:49:46 +03:00
?: (~(has by bureau) (shaf %pass pas))
~|(already-recycled+[him-t tik-t] !!)
2016-05-04 20:58:35 +03:00
=+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~])
2016-07-07 00:49:46 +03:00
.(bureau (~(put by bureau) (shaf %pass pas) bal))
2016-05-04 20:58:35 +03:00
::
2016-04-15 03:04:19 +03:00
++ poke-claim :: claim plot, req ticket
2016-04-14 23:49:39 +03:00
|= {aut/passcode her/@p}
?. can-claim.cfg ~|(%ticketing-offline !!)
2016-04-08 20:08:05 +03:00
=< abet
2016-04-30 02:18:59 +03:00
=. log-transaction (log-transaction %claim +<)
2016-04-12 22:02:59 +03:00
?> =(src src)
2016-05-04 20:58:35 +03:00
(claim-any aut her)
::
++ claim-any :: register
2016-05-04 20:58:35 +03:00
|= {aut/passcode her/@p}
2016-04-15 03:04:19 +03:00
=; claimed
2016-04-30 03:18:22 +03:00
:: =. claimed (emit.claimed %wait $~) :: XX delay ack
(emit.claimed %poke /tick [(sein her) %hood] [%womb-do-ticket her])
2016-07-07 00:49:46 +03:00
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
2016-04-14 23:49:39 +03:00
?+ (clan her) ~|(bad-size+(clan her) !!)
$king
2016-04-15 03:04:19 +03:00
=; all (claim-star.all owner.bal her)
2016-04-15 02:37:13 +03:00
=+ (use-reference &+src)
?^ - u :: prefer using references
=+ (use-reference |+owner.bal)
?^ - u
2016-04-14 23:49:39 +03:00
=. stars.bal ~|(%no-stars (dec stars.bal))
2016-07-07 00:49:46 +03:00
+>.$(bureau (~(put by bureau) (shaf %pass aut) bal))
2016-04-14 23:49:39 +03:00
::
$duke
=. planets.bal ~|(%no-planets (dec planets.bal))
2016-07-07 00:49:46 +03:00
=. bureau (~(put by bureau) (shaf %pass aut) bal)
2016-04-14 23:49:39 +03:00
(claim-planet owner.bal her)
==
::
++ claim-star :: register
|= {who/mail her/@p} ^+ +>
%+ mod-managed-star her
|= a/star ^- star
?^ a ~|(impure-star+[her a] !!)
(some %| who)
::
++ claim-planet :: register
|= {who/mail her/@p} ^+ +>
=. hotel
2016-04-15 02:37:13 +03:00
%+ ~(put by hotel) |+who
=+ cli=(fall (~(get by hotel) |+who) *client)
2016-04-14 23:49:39 +03:00
cli(has (~(put in has.cli) her))
%+ mod-managed-planet her
|= a/planet ^- planet
?^ a ~|(impure-planet+[her a] !!)
(some %| who)
2016-04-08 20:08:05 +03:00
::
++ poke-release :: release to subdivide
|= {gal/@ud sta/@ud} ::
2016-04-13 00:54:50 +03:00
=< abet ^+ +>
2016-07-06 09:57:25 +03:00
=. log-transaction (log-transaction %release +<)
2016-04-08 20:08:05 +03:00
?> =(our src) :: privileged
2016-04-13 00:54:50 +03:00
=. +>
?~ 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." ~)
2016-04-13 00:54:50 +03:00
?. (gth sta (lent all))
(roll all release-star)
~|(too-few-stars+[want=sta has=(lent all)] !!)
::
2016-04-14 00:06:58 +03:00
++ release-galaxy :: subdivide %czar
2016-04-13 00:54:50 +03:00
=+ [who=*@p res=.]
|. ^+ res
2016-04-13 23:32:45 +03:00
%+ mod-managed-galaxy:res who
|= gal/galaxy ^- galaxy
2016-04-13 03:10:53 +03:00
~& release+who
2016-04-13 00:54:50 +03:00
?^ gal ~|(already-used+who !!)
2016-04-13 23:32:45 +03:00
(some %& (fo-init 5) (fo-init 4) (fo-init 3))
2016-04-13 00:54:50 +03:00
::
2016-04-14 00:06:58 +03:00
++ release-star :: subdivide %king
2016-04-13 00:54:50 +03:00
=+ [who=*@p res=.]
|. ^+ res
2016-08-05 23:17:01 +03:00
=. res (emit.res %poke /tick [(sein who) %hood] [%womb-do-ticket who])
2016-04-13 23:32:45 +03:00
%+ mod-managed-star:res who
|= sta/star ^- star
2016-04-13 00:54:50 +03:00
~& release+who
2016-04-13 23:32:45 +03:00
?^ sta ~|(already-used+[who u.sta] !!)
(some %& (fo-init 4) (fo-init 3))
2016-04-08 20:08:05 +03:00
--