shrub/lib/womb.hoon

439 lines
20 KiB
Plaintext
Raw Normal View History

2016-04-08 20:08:05 +03:00
:: :: ::
:::: /hoon/womb/lib :: ::
:: :: ::
/? 310 :: version
/+ talk, old-phon
=, wired
=, title
=, womb:^jael
2016-04-08 20:08:05 +03:00
:: :: ::
:::: :: ::
:: :: ::
2016-10-13 02:18:10 +03:00
:: |%
:: ++ foil :: ship allocation map
:: |* mold :: entry mold
:: $: min/@u :: minimum entry
:: ctr/@u :: next allocated
:: und/(set @u) :: free under counter
:: ove/(set @u) :: alloc over counter
:: max/@u :: maximum entry
:: box/(map @u +<) :: entries
:: == ::
:: -- ::
:: ::
:::: ::
:: ::
2016-04-08 20:08:05 +03:00
|% ::
2016-10-13 02:18:10 +03:00
:: ++ managed :: managed plot
:: |* mold ::
:: %- unit :: unsplit
:: %+ each +< :: subdivided
:: mail :: delivered
:: :: ::
:: ++ divided :: get division state
:: |* (managed) ::
:: ?- +< ::
:: $~ ~ :: unsplit
:: {$~ $| *} ~ :: delivered
:: {$~ $& *} (some p.u.+<) :: subdivided
:: == ::
:: :: ::
:: ++ moon (managed _!!) :: undivided moon
:: ::
:: ++ planet :: subdivided planet
:: (managed (lone (foil moon))) ::
:: :: ::
:: ++ star :: subdivided star
:: (managed (pair (foil moon) (foil planet))) ::
:: :: ::
:: ++ galaxy :: subdivided galaxy
:: (managed (trel (foil moon) (foil planet) (foil star)))::
:: :: ::
++ ticket @G :: old 64-bit ticket
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
== ::
2016-10-13 02:18:10 +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
== ::
++ 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} ::
2016-11-07 03:45:29 +03:00
{term p/*} :: 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-10-13 02:26:30 +03:00
:: bureau/(map passhash balance) :: active invitations
2016-10-13 02:18:10 +03:00
:: office/property :: properties managed
2016-07-06 09:57:25 +03:00
recycling/(map ship @) :: old ticket keys
2016-04-08 20:08:05 +03:00
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|% :: arvo structures
2016-10-13 01:46:23 +03:00
++ invite-j {who/mail pla/@ud sta/@ud} :: invite data
2016-10-13 23:16:53 +03:00
++ balance-j {who/mail pla/@ud sta/@ud} :: balance data
2016-10-13 01:46:23 +03:00
++ 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
2016-10-13 23:16:53 +03:00
== ::
2016-04-08 20:08:05 +03:00
++ card ::
2016-11-07 03:45:29 +03:00
$% {$flog wire flog:^dill} ::
{$info wire @p @tas nori:^clay} :: fs write (backup)
:: {$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/wyll:^ames} :: learn will (old pki)
{$jaelwomb wire task:womb} :: manage rights
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} ::
2016-10-13 02:18:10 +03:00
:: {$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
2016-11-07 03:45:29 +03:00
$% {$report her/@p wyl/wyll:^ames}
2016-04-30 02:18:59 +03:00
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
2016-08-12 02:16:05 +03:00
{$bonus tid/cord pla/@ud sta/@ud}
2016-10-13 00:53:55 +03:00
{$invite tid/cord 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]))
::
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
2016-04-13 01:59:26 +03:00
::
2016-04-12 22:02:59 +03:00
--
2016-04-08 20:08:05 +03:00
:: :: ::
:::: :: ::
2016-11-17 04:42:58 +03:00
:: :: ::
=+ cfg=[can-claim=& can-recycle=&] :: temporarily disabled
2016-11-07 03:45:29 +03:00
=+ [replay=| stat-no-email=|] :: XX globals
|= {bowl:^gall 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.+<)))
::
++ 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
::
2016-10-13 23:16:53 +03:00
++ jael-scry
|* {typ/mold pax/path} ^- typ
.^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax))
::
++ jael-pas-balance
|= pas/passcode ^- (unit balance)
%+ bind (jael-scry (unit balance-j) /balance/(scot %uv pas)/womb-balance)
|= a/balance-j ^- balance
=/ hiz/(list mail) ~ :: XX track history in jael
[pla.a sta.a who.a hiz]
::
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-10-13 02:18:10 +03:00
=; res/(list ship) (some (some [%ships res]))
2016-10-13 23:16:53 +03:00
:: XX redundant parse?
=+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud]))
(jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships)
2016-04-13 23:32:45 +03:00
::
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-14 01:03:05 +03:00
::
2016-04-14 00:06:58 +03:00
++ stats-ship :: inspect ship
|= who/@p ^- stat
2016-10-13 02:18:10 +03:00
:- (get-live who)
2016-10-13 23:16:53 +03:00
=/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned u.man]
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
2016-10-13 23:16:53 +03:00
:: XX redundant parse?
=+ who=~|(bad-path+tyl (raid tyl /[who=%p]))
``womb-stat+(stats-ship who)
2016-10-13 02:18:10 +03:00
!! :: XX meaningful and/or useful in sein-jael model?
:: ^- (unit (unit {$womb-stat-all (map ship stat)}))
:: =. stat-no-email & :: censor adresses
:: :^ ~ ~ %womb-stat-all
:: %- ~(uni by (~(urn by planets.office) stat-planet))
:: %- ~(uni by (~(urn by stars.office) stat-star))
:: (~(urn by galaxies.office) stat-galaxy)
2016-04-12 22:02:59 +03:00
::
++ peek-x-balance :: inspect invitation
2016-04-30 00:22:25 +03:00
|= tyl/path
^- (unit (unit {$womb-balance balance}))
2016-10-13 23:16:53 +03:00
:: XX redundant parse?
=+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv]))
2016-04-12 22:02:59 +03:00
%- some
2016-10-13 23:16:53 +03:00
%+ bind (jael-pas-balance pas)
|=(a/balance [%womb-balance a])
2016-04-12 22:02:59 +03:00
::
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-10-13 23:16:53 +03:00
?^ (jael-pas-balance 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-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-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] +>)
2016-08-13 00:56:20 +03:00
(emit %poke womb+[%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 +>
2016-08-13 00:56:20 +03:00
(emit %poke /womb/log [our %hood] %drum-put /womb-events/(scot %da now)/hoon (crip <eny a>))
2016-04-30 02:18:59 +03:00
::
++ poke-replay-log :: rerun transactions
2016-08-12 22:25:10 +03:00
|= a/(list {eny/@uvJ pok/transaction})
2016-04-30 02:18:59 +03:00
?~ 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))
2016-08-12 02:16:05 +03:00
$bonus (teba (poke-bonus +.pok.i.a))
2016-04-30 02:18:59 +03:00
$invite (teba (poke-invite +.pok.i.a))
$report (teba (poke-report +.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-08-12 02:16:05 +03:00
++ poke-bonus :: expand invitation
|= {tid/cord pla/@ud sta/@ud}
=< abet
=. log-transaction (log-transaction %bonus +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
2016-10-13 01:46:23 +03:00
(emit %jaelwomb / %bonus pas pla sta)
2016-08-12 02:16:05 +03:00
::
2016-04-08 20:08:05 +03:00
++ poke-invite :: create invitation
2016-10-13 00:53:55 +03:00
|= {tid/cord 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 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-10-13 01:46:23 +03:00
=. emit (emit %jaelwomb / %invite pas [who pla sta]:inv)
2016-07-07 02:06:29 +03:00
(email /invite who.inv intro.wel.inv)
2016-04-14 23:49:39 +03:00
::
++ 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-10-13 01:25:10 +03:00
=/ pas/@uv (end 7 1 (shaf %pass eny))
2016-10-13 01:46:23 +03:00
=. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
2016-10-13 01:25:10 +03:00
(email /invite who.inv intro.wel.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])
2016-12-02 02:59:17 +03:00
%+ foal:space:userlib
2016-11-02 04:43:27 +03:00
(welp pax /jam-crub)
[%jam-crub !>((en:crub:crypto pas (jam `part`+:abet)))]
2016-04-19 01:15:35 +03:00
::
2016-10-28 08:29:29 +03:00
++ poke-rekey :: extend wyll
2016-04-12 22:02:59 +03:00
|= $~
2016-04-08 20:08:05 +03:00
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
:: (emit /rekey %next sec:ex:(pit:nu:crub 512 (shaz (mix %next (shaz eny)))))
~& %rekey-stub .
2016-04-08 20:08:05 +03:00
::
2016-10-28 08:29:29 +03:00
++ poke-report :: report wyll
2016-11-08 04:40:00 +03:00
|= {her/@p wyl/wyll:^ames} ::
2016-04-08 20:08:05 +03:00
=< 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
::
++ 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-10-13 01:57:22 +03:00
:: ?^ (scry-womb-invite (shaf %pass pas))
:: ~|(already-recycled+[him-t tik-t] !!)
2016-10-13 01:25:10 +03:00
=/ inv/{pla/@ud sta/@ud}
?+((clan him) !! $duke [0 1], $king [1 0])
2016-10-13 01:46:23 +03:00
(emit %jaelwomb / %invite pas who inv)
2016-10-13 01:25:10 +03:00
::
::
:: ++ jael-claimed 'Move email here if an ack is necessary'
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-10-13 23:16:53 +03:00
=/ bal ~|(%bad-invite (need (jael-pas-balance aut)))
2016-10-13 01:25:10 +03:00
=/ tik/ticket (end 6 1 (shas %tick eny))
2016-10-13 01:46:23 +03:00
=. emit (emit %jaelwomb / %claim aut her tik)
2016-10-13 01:25:10 +03:00
:: XX event crashes work properly yes?
2016-10-13 23:16:53 +03:00
(email /ticket owner.bal "Ticket for {<her>}: {<`@pG`tik>}")
2016-04-08 20:08:05 +03:00
--