shrub/lib/womb.hoon

::                                                      ::  ::
::::  /hoon/womb/lib                                    ::  ::
  ::                                                    ::  ::
/?    310                                               ::  version
/+    talk, old-phon
::                                                      ::  ::
::::                                                    ::  ::
  ::                                                    ::  ::
:: |%
:: ++  foil                                                ::  ship allocation map
::   |*  mold                                              ::  entry mold
::   $:  min/@u                                            ::  minimum entry
::       ctr/@u                                            ::  next allocated
::       und/(set @u)                                      ::  free under counter
::       ove/(set @u)                                      ::  alloc over counter
::       max/@u                                            ::  maximum entry
::       box/(map @u +<)                                   ::  entries
::   ==                                                    ::
:: --                                                      ::
::                                                      ::
::::                                                    ::
  ::                                                    ::
|%                                                      ::
:: ++  managed                                             ::  managed plot
::   |*  mold                                              ::
::   %-  unit                                              ::  unsplit
::   %+  each  +<                                          ::  subdivided
::   mail                                                  ::  delivered
:: ::                                                      ::
:: ++  divided                                             ::  get division state
::   |*  (managed)                                         ::
::   ?-  +<                                                ::
::     $~      ~                                           ::  unsplit
::     {$~ $| *}  ~                                        ::  delivered
::     {$~ $& *}  (some p.u.+<)                            ::  subdivided
::   ==                                                    ::
:: ::                                                      ::
:: ++  moon  (managed _!!)                                 ::  undivided moon
:: ::
:: ++  planet                                              ::  subdivided planet
::   (managed (lone (foil moon)))                          ::
:: ::                                                      ::
:: ++  star                                                ::  subdivided star
::   (managed (pair (foil moon) (foil planet)))            ::
:: ::                                                      ::
:: ++  galaxy                                              ::  subdivided galaxy
::   (managed (trel (foil moon) (foil planet) (foil star)))::
:: ::                                                      ::
++  ticket  @G                                          ::  old 64-bit ticket
++  passcode  @uvH                                      ::  128-bit passcode
++  passhash  @uwH                                      ::  passocde hash
++  mail  @t                                            ::  email address
++  balance                                             ::  invitation balance
  $:  planets/@ud                                       ::  planet count
      stars/@ud                                         ::  star count
      owner/mail                                        ::  owner's email
      history/(list mail)                               ::  transfer history
  ==                                                    ::
:: ++  property                                            ::  subdivided plots
::   $:  galaxies/(map @p galaxy)                          ::  galaxy
::       planets/(map @p planet)                           ::  star
::       stars/(map @p star)                               ::  planet
::   ==                                                    ::
++  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
  $%  {$free $~}                                        ::  unallocated
      {$owned p/mail}                                   ::  granted, status
      {$split p/(map ship stat)}                        ::  all given ships
  ==                                                    ::
::                                                      ::
++  ames-tell                                           ::  .^ a+/=tell= type
  |^  {p/(list elem) q/(list elem)}                     ::
  ++  elem  $^  {p/elem q/elem}                         ::
            {term p/*}                                  ::  somewhat underspecified
  --                                                    ::
--                                                      ::
::                                                      ::  ::
::::                                                    ::  ::
  ::                                                    ::  ::
|%
++  part  {$womb $1 pith}                               ::  womb state
++  pith                                                ::  womb content
  $:  boss/(unit ship)                                  ::  outside master
      bureau/(map passhash balance)                     ::  active invitations
::       office/property                                   ::  properties managed
      recycling/(map ship @)                            ::  old ticket keys
  ==                                                    ::
--                                                      ::
::                                                      ::  ::
::::                                                    ::  ::
  ::                                                    ::  ::
|%                                                      ::  arvo structures
++  invite-j  {who/mail pla/@ud sta/@ud}                ::  invite data
++  womb-task                                           ::  manage ship %fungi
  $%  {$claim aut/passcode her/@p tik/ticket}           ::  convert to %final
      {$bonus tid/passcode pla/@ud sta/@ud}             ::  supplement passcode
      {$invite tid/passcode inv/invite-j}               ::  alloc to passcode
      {$reinvite aut/passcode tid/passcode inv/invite-j}::  move to another
  ==
++  card                                                ::
  $%  {$flog wire flog}                                 ::
      {$info wire @p @tas nori}                         ::  fs write (backup)
      :: {$wait $~}                                        :: delay acknowledgment
      {$diff gilt}                                      :: subscription response
      {$poke wire dock pear}                            ::  app RPC
      {$next wire p/ring}                               ::  update private key
      {$tick wire p/@pG q/@p}                           ::  save ticket
      {$knew wire p/ship q/will}                        ::  learn will (old pki)
      {$jaelwomb wire womb-task}                        ::  manage rights
  ==                                                    ::
++  pear                                                ::
  $%  {$email mail tape wall}                           ::  send email
      {$womb-do-ticket ship}                            ::  request ticket
      {$womb-do-claim ship @p}                          ::  issue ship
      {$drum-put path @t}                               ::  log transaction
  ==                                                    ::
++  gilt                                                :: scry result
  $%  {$ships (list ship)}                              ::
      {$womb-balance balance}                           ::
      {$womb-balance-all (map passhash mail)}           ::
      {$womb-stat stat}                                 ::
::       {$womb-stat-all (map ship stat)}                  ::
      {$womb-ticket-info passcode ?($fail $good $used)} ::
  ==
++  move  (pair bone card)                              ::  user-level move
::
++  transaction                                         ::  logged poke
  $%  {$report her/@p wyl/will}
::       {$release gal/@ud sta/@ud}
::       {$release-ships (list ship)}
      {$claim aut/passcode her/@p}
      {$recycle who/mail him/knot tik/knot}
      {$bonus tid/cord pla/@ud sta/@ud}
      {$invite tid/cord inv/invite}
      {$reinvite aut/passcode inv/invite}
  ==
--
|%
++  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))
::
++  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))
::   ^-  (list {ship _(need (divided *~(got by a)))})
::   (sort (~(tap by (murn-by a divided))) lor)
:: ::
:: ++  issuing-under
::   |*  {a/bloq b/ship c/(map @u (managed))}
::   ^-  (list {ship _(need (divided *~(got by c)))})
::   %+  turn  (sort (~(tap by (murn-by c divided))) lor)
::   |*(d/{@u *} [(rep a b -.d ~) +.d])
:: ++  cursor  (pair (unit ship) @u)
++  neis  |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a)))  ::  postfix
::
::  Create new foil of size
:: ++  fo-init
::   |=  a/bloq  ::  ^-  (foil *)
::   [min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
::
:: ++  fo
::   |_  (foil $@($~ *))
::   ++  nth                                             ::  index
::     |=  a/@u  ^-  (pair (unit @u) @u)
::     ?:  (lth a ~(wyt in und))
::       =+  out=(snag a (sort (~(tap in und)) lth))
::       [(some out) 0]
::     =.  a  (sub a ~(wyt in und))
::     |-  ^-  {(unit @u) @u}
::     ?:  =(ctr +(max))  [~ a]
::     ?:  =(0 a)  [(some ctr) a]
::     $(a (dec a), +<.nth new)
::   ::
::   +-  fin  +<                                         ::  abet
::   ++  new                                             ::  alloc
::     ?:  =(ctr +(max))  +<
::     =.  ctr  +(ctr)
::     ?.  (~(has in ove) ctr)  +<
::     new(ove (~(del in ove) ctr))
::   ::
::   +-  get                                             ::  nullable
::     |=  a/@p  ^+  ?~(box ~ q.n.box)
::     (fall (~(get by box) (neis a)) ~)
::   ::
::   +-  put
::     |*  {a/@u b/*}  ^+  fin           ::  b/_(~(got by box))
::     ~|  put+[a fin]
::     ?>  (fit a)
::     =;  adj  adj(box (~(put by box) a b))
::     ?:  (~(has in box) a)  fin
::     ?:  =(ctr a)  new
::     ?:  (lth a ctr)
::       ?.  (~(has in und) a)  fin
::       fin(und (~(del in und) a))
::     ?.  =(a ctr:new)    :: heuristic
::       fin(ove (~(put in ove) a))
::     =+  n=new(+< new)
::     n(und (~(put in und.n) ctr))
::   ::
::   ++  fit  |=(a/@u &((lte min a) (lte a max)))        ::  in range
::   ++  gud                                             ::  invariant
::     ?&  (fit(max +(max)) ctr)
::         (~(all in und) fit(max ctr))
::         (~(all in ove) fit(min ctr))
::         (~(all in box) |=({a/@u *} (fit a)))
::         |-  ^-  ?
::         ?:  =(min max)  &
::         =-  &(- $(min +(min)))
::         %+  gte  1              ::  at most one of
::         ;:  add
::           ?:(=(min ctr) 1 0)
::           ?:((~(has in und) min) 1 0)
::           ?:((~(has in ove) min) 1 0)
::           ?:((~(has by box) min) 1 0)
::         ==
::     ==
::   --
--
::                                                    ::  ::
::::                                                  ::  ::
  !:                                                  ::  ::
=+  cfg=[can-claim=& can-recycle=&]                   ::  temporarily disabled
=+  [replay=| stat-no-email=|]                              ::  XX globals
|=  {bowl part}                                       ::  main womb work
|_  moz/(list move)
++  abet                                              ::  resolve
  ^-  (quip move *part)
  [(flop moz) +>+<+]
::
++  teba                                              ::  install resolved
  |=  a/(quip move *part)  ^+  +>
  +>(moz (flop -.a), +>+<+ +.a)
::
++  emit  |=(card %_(+> moz [[ost +<] moz]))          ::  return card
++  emil                                              ::  return cards
  |=  (list card)
  ^+  +>
  ?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
::
:: ++  take-n                                            ::  compute range
::   |=  {{index/@u count/@u} get/$-(@u cursor)}
::   ^-  (list ship)
::   ?~  count  ~
::   %+  biff  p:(get index)
::   |=  a/ship  ^-  (list ship)
::   [a ^$(index +(index), count (dec count))]
:: ::
:: ++  available                                         ::  enumerate free ships
::   |=  all/(map ship (managed))  ^-  $-(@u cursor)
::   =+  pur=(sort (turn (unsplit all) head) lth)
::   =+  len=(lent pur)
::   |=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a]))
::
:: foil cursor to ship cursor, using sized parent
:: ++  prefix
::   |=  {a/bloq b/@p {c/(unit @u) d/@u}}  ^-  cursor
::   ?~  c  [c d]
::   [(some (rep a b u.c ~)) d]
::
:: ++  in-list                                           ::  distribute among options
::   |*  {a/(list) b/@u}  ^+  [(snag *@ a) b]
::   =+  c=(lent a)
::   [(snag (mod b c) a) (div b c)]
:: ::
++  ames-last-seen                                    ::  last succesful ping
  |=  a/ship  ~+  ^-  (unit time)
  ?:  =(a our)  (some now)
  %-  (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))
::
++  neighboured                                        ::  filter for connectivity
  |*  a/(list {ship *})  ^+  a
  %+  skim  a
  |=  {b/ship *}
  ?=(^ (ames-last-seen b))
::
::
:: ++  shop-galaxies  (available galaxies.office)        ::  unassigned %czar
:: ::
:: ::  Stars can be either whole or children of galaxies
:: ++  shop-stars                                        ::  unassigned %king
::   |=  nth/@u  ^-  cursor
::   =^  out  nth  %.(nth (available stars.office))
::   ?^  out  [out nth]
::   %+  shop-star   nth
::   (neighboured (issuing galaxies.office))
:: ::
:: ++  shop-star                                         ::  star from galaxies
::   |=  {nth/@u lax/(list {who/@p * * r/(foil star)})}  ^-  cursor
::   ?:  =(~ lax)  [~ nth]
::   =^  sel  nth  (in-list lax nth)
::   (prefix 3 who.sel (~(nth fo r.sel) nth))
:: ::
:: ++  shop-planets                                      ::  unassigned %duke
::   |=  nth/@u  ^-  cursor
::   =^  out  nth  %.(nth (available planets.office))
::   ?^  out  [out nth]
::   =^  out  nth
::     %+  shop-planet   nth
::     (neighboured (issuing stars.office))
::   ?^  out  [out nth]
::   (shop-planet-gal nth (issuing galaxies.office))
:: ::
:: ++  shop-planet                                       ::  planet from stars
::   |=  {nth/@u sta/(list {who/@p * q/(foil planet)})}  ^-  cursor
::   ?:  =(~ sta)  [~ nth]
::   =^  sel  nth  (in-list sta nth)
::   (prefix 4 who.sel (~(nth fo q.sel) nth))
:: ::
:: ++  shop-planet-gal                                   ::  planet from galaxies
::   |=  {nth/@u lax/(list {who/@p * * r/(foil star)})}  ^-  cursor
::   ?:  =(~ lax)  [~ nth]
::   =^  sel  nth  (in-list lax nth)
::   %+  shop-planet   nth
::   (neighboured (issuing-under 3 who.sel box.r.sel))
:: ::
++  peek-x-shop                                       ::  available ships
  |=  tyl/path  ^-  (unit (unit {$ships (list @p)}))
  =;  a   ~&  peek-x-shop+[tyl a]  a
  =;  res/(list ship)  (some (some [%ships res]))
  =+  [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
  :: =.  nth  (mul 3 nth)
  !! :: XX scry jael
::   ?+  typ  ~|(bad-type+typ !!)
::     $galaxies  (take-n [nth 3] shop-galaxies)
::     $planets   (take-n [nth 3] shop-planets)
::     $stars     (take-n [nth 3] shop-stars)
::   ==
::
:: ++  get-managed-galaxy  ~(got by galaxies.office)     ::  office read
:: ++  mod-managed-galaxy                                ::  office write
::   |=  {who/@p mod/$-(galaxy galaxy)}  ^+  +>
::   =+  gal=(mod (get-managed-galaxy who))
::   +>.$(galaxies.office (~(put by galaxies.office) who gal))
:: ::
:: ++  get-managed-star                                  ::  office read
::   |=  who/@p  ^-  star
::   =+  (~(get by stars.office) who)
::   ?^  -  u
::   =+  gal=(get-managed-galaxy (sein who))
::   ?.  ?=({$~ $& *} gal)  ~|(unavailable-star+(sein who) !!)
::   (fall (~(get by box.r.p.u.gal) (neis who)) ~)
:: ::
:: ++  mod-managed-star                                  ::  office write
::   |=  {who/@p mod/$-(star star)}  ^+  +>
::   =+  sta=(mod (get-managed-star who))                ::  XX double traverse
::   ?:  (~(has by stars.office) who)
::     +>.$(stars.office (~(put by stars.office) who sta))
::   %+  mod-managed-galaxy  (sein who)
::   |=  gal/galaxy  ^-  galaxy
::   ?>  ?=({$~ $& *} gal)
::   gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta))
:: ::
:: ++  get-managed-planet                                ::  office read
::   |=  who/@p  ^-  planet
::   =+  (~(get by planets.office) who)
::   ?^  -  u
::   ?:  (~(has by galaxies.office) (sein who))
::     =+  gal=(get-managed-galaxy (sein who))
::     ?.  ?=({$~ $& *} gal)  ~|(unavailable-galaxy+(sein who) !!)
::     (~(get fo q.p.u.gal) who)
::   =+  sta=(get-managed-star (sein who))
::   ?.  ?=({$~ $& *} sta)  ~|(unavailable-star+(sein who) !!)
::   (~(get fo q.p.u.sta) who)
:: ::
:: ++  mod-managed-planet                                ::  office write
::   |=  {who/@p mod/$-(planet planet)}  ^+  +>
::   =+  pla=(mod (get-managed-planet who))              ::  XX double traverse
::   ?:  (~(has by planets.office) who)
::     +>.$(planets.office (~(put by planets.office) who pla))
::   ?:  (~(has by galaxies.office) (sein who))
::     %+  mod-managed-galaxy  (sein who)
::     |=  gal/galaxy  ^-  galaxy
::     ?>  ?=({$~ $& *} gal)
::     gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla))
::   %+  mod-managed-star  (sein who)
::   |=  sta/star  ^-  star
::   ?>  ?=({$~ $& *} sta)
::   sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla))
::
++  get-live                                          ::  last-heard time ++live
  |=  a/ship  ^-  live
  =+  rue=(ames-last-seen a)
  ?~  rue  %cold
  ?:((gth (sub now u.rue) ~m5) %seen %live)
::
:: ++  stat-any                                          ::  unsplit status
::   |=  {who/@p man/(managed _!!)}  ^-  stat
::   :-  (get-live who)
::   ?~  man  [%free ~]
::   ?:  stat-no-email  [%owned '']
::   [%owned p.u.man]
:: ::
:: ++  stat-planet                                       ::  stat of planet
::   |=  {who/@p man/planet}  ^-  stat
::   ?.  ?=({$~ $& ^} man)  (stat-any who man)
::   :-  (get-live who)
::   =+  pla=u:(divided man)
::   :-  %split
::   %-  malt
::   %+  turn  (~(tap by box.p.pla))
::   |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
:: ::
:: ++  stat-star                                         ::  stat of star
::   |=  {who/@p man/star}  ^-  stat
::   ?.  ?=({$~ $& ^} man)  (stat-any who man)
::   :-  (get-live who)
::   =+  sta=u:(divided man)
::   :-  %split
::   %-  malt
::   %+  welp
::     %+  turn  (~(tap by box.p.sta))
::     |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::   %+  turn  (~(tap by box.q.sta))
::   |=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
:: ::
:: ++  stat-galaxy                                       :: stat of galaxy
::   |=  {who/@p man/galaxy}  ^-  stat
::   ?.  ?=({$~ $& ^} man)  (stat-any who man)
::   =+  gal=u:(divided man)
::   :-  (get-live who)
::   :-  %split
::   %-  malt
::   ;:  welp
::     %+  turn  (~(tap by box.p.gal))
::     |=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::   ::
::     %+  turn  (~(tap by box.q.gal))
::     |=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::   ::
::     %+  turn  (~(tap by box.r.gal))
::     |=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)]))
::   ==
::
++  stats-ship                                        ::  inspect ship
  |=  who/@p  ^-  stat
  :-  (get-live who)
  !!  :: XX scry jael
::   ?-  (clan who)
::     $pawn  !!
::     $earl  !!
::     $duke  (stat-planet who (get-managed-planet who))
::     $king  (stat-star who (get-managed-star who))
::     $czar  (stat-galaxy who (get-managed-galaxy who))
::   ==
::
++  peek-x-stats                                      ::  inspect ship/system
  |=  tyl/path
  ?^  tyl
    ?>  |(=(our src) =([~ src] boss))                   ::  privileged info
    ``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
  !!  ::  XX meaningful and/or useful in sein-jael model?
::   ^-  (unit (unit {$womb-stat-all (map ship stat)}))
::   =.  stat-no-email  &                      ::  censor adresses
::   :^  ~  ~  %womb-stat-all
::   %-  ~(uni by (~(urn by planets.office) stat-planet))
::   %-  ~(uni by (~(urn by stars.office) stat-star))
::   (~(urn by galaxies.office) stat-galaxy)
::
++  peek-x-balance                                     ::  inspect invitation
  |=  tyl/path
  ?~  tyl
    ?>  |(=(our src) =([~ src] boss))                  ::  priveledged
    ``[%womb-balance-all (~(run by bureau) |=(balance owner))]
  ^-  (unit (unit {$womb-balance balance}))
  =+  pas=~|(bad-path+tyl (raid tyl pas=%uv ~))
  %-  some
  %+  bind  (~(get by bureau) (shaf %pass pas))
  |=(bal/balance [%womb-balance bal])
::
++  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)))))
::
::
++  peek-x-ticket
  |=  tyl/path
  ^-  (unit (unit {$womb-ticket-info passcode ?($fail $good $used)}))
  ?.  ?=({@ @ $~} 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
  ?:  (~(has by bureau) (shaf %pass pas))  %used
  %good
::
++  peer-scry-x                                        ::  subscription like .^
  |=  tyl/path
  =<  abet
  =+  gil=(peek-x tyl)
  ~|  tyl
  ?~  gil  ~|(%block-stub !!)
  ?~  u.gil  ~|(%bad-path !!)
  (emit %diff u.u.gil)
::
++  peek-x                                             ::  stateless read
  |=  tyl/path  ^-  (unit (unit gilt))
  ~|  peek+x+tyl
  ?~  tyl  ~
  ?+  -.tyl  ~
  ::  /shop/planets/@ud   (list @p)    up to 3 planets
  ::  /shop/stars/@ud     (list @p)    up to 3 stars
  ::  /shop/galaxies/@ud  (list @p)    up to 3 galaxies
    $shop  (peek-x-shop +.tyl)
  ::  /stats                          general stats dump
  ::  /stats/@p                       what we know about @p
    $stats  (peek-x-stats +.tyl)
  ::  /balance                         all invitations
  ::  /balance/passcode                invitation status
    $balance  (peek-x-balance +.tyl)
  ::  /ticket/ship/ticket              check ticket usability
    $ticket  (peek-x-ticket +.tyl)
  ==
::
++  poke-manage-old-key                               ::  add to recyclable tickets
  |=  {a/ship b/@}
  =<  abet
  ?>  |(=(our src) =([~ src] boss))                   ::  privileged
  .(recycling (~(put by recycling) a b))
::
:: ++  poke-manage                                       ::  add to property
::   |=  a/(list ship)
::   =<  abet
::   ?>  |(=(our src) =([~ src] boss))                   ::  privileged
::   |-
::   ?~  a  .
::   ?+      (clan i.a)  ~|(bad-size+(clan i.a) !!)
::         $duke
::     ?.  (~(has by planets.office) i.a)
::       $(a t.a, planets.office (~(put by planets.office) i.a ~))
::     ~|(already-managing+i.a !!)
::   ::
::         $king
::     ?.  (~(has by stars.office) i.a)
::       $(a t.a, stars.office (~(put by stars.office) i.a ~))
::     ~|(already-managing+i.a !!)
::   ::
::         $czar
::     ?.  (~(has by galaxies.office) i.a)
::       $(a t.a, galaxies.office (~(put by galaxies.office) i.a ~))
::     ~|(already-managing+i.a !!)
::   ==
::
++  email                                             ::  send email
  |=  {wir/wire adr/mail msg/tape}  ^+  +>
  ?:  replay  +>                      ::  dont's send email in replay mode
  ~&  do-email+[adr msg]
  ::~&([%email-stub adr msg] +>)
  (emit %poke womb+[%mail wir] [our %gmail] %email adr "Your Urbit Invitation" [msg]~)
::
++  log-transaction                                   ::  logged poke
  |=  a/transaction  ^+  +>
  ?:  replay  +>
  (emit %poke /womb/log [our %hood] %drum-put /womb-events/(scot %da now)/hoon (crip <eny a>))
::
++  poke-replay-log                                   ::  rerun transactions
  |=  a/(list {eny/@uvJ pok/transaction})
  ?~  a  abet
  ~&  womb-replay+-.pok.i.a
  =.  eny  eny.i.a
  =.  replay  &
  %_    $
      a  t.a
      +>
    ?-  -.pok.i.a
      $claim     (teba (poke-claim +.pok.i.a))
      $bonus    (teba (poke-bonus +.pok.i.a))
      $invite    (teba (poke-invite +.pok.i.a))
      $report    (teba (poke-report +.pok.i.a))
::       $release   (teba (poke-release +.pok.i.a))
      $recycle   (teba (poke-recycle +.pok.i.a))
      $reinvite  (teba (poke-reinvite +.pok.i.a))
::       $release-ships  (teba (poke-release-ships +.pok.i.a))
    ==
  ==
::
++  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))
  (emit %jaelwomb / %bonus pas pla sta)
::
++  poke-invite                                       ::  create invitation
  |=  {tid/cord inv/invite}
  =<  abet
  =.  log-transaction  (log-transaction %invite +<)
  ?>  |(=(our src) =([~ src] boss))                   ::  priveledged
  =+  pas=~|(bad-invite+tid `passcode`(slav %uv tid))
  =.  emit  (emit %jaelwomb / %invite pas [who pla sta]:inv)
  (email /invite who.inv intro.wel.inv)
::
++  poke-reinvite                                     ::  split invitation
  |=  {aut/passcode inv/invite}                       ::  further invite
  =<  abet
  =.  log-transaction  (log-transaction %reinvite +<)
  ?>  =(src src)                                      ::  self-authenticated
  =+  ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
  =/  pas/@uv  (end 7 1 (shaf %pass eny))
  =.  emit  (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
  (email /invite who.inv intro.wel.inv)
::
++  poke-obey                                         ::  set/reset boss
  |=  who/(unit @p)
  =<  abet
  ?>  =(our src)                                      ::  me only
  .(boss who)
::
++  poke-save                                         ::  write backup
  |=  pax/path
  =<  abet
  ?>  =(our src)                                      ::  me only
  =+  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)))]
::
++  poke-rekey                                        ::  extend will
  |=  $~
  =<  abet
  ?>  |(=(our src) =([~ src] boss))                   ::  privileged
  ::  (emit /rekey %next sec:ex:(pit:nu:crub 512 (shaz (mix %next (shaz eny)))))
  ~&  %rekey-stub  .
::
++  poke-report                                       ::  report will
  |=  {her/@p wyl/will}                               ::
  =<  abet
  =.  log-transaction  (log-transaction %report +<)
  ?>  =(src src)                                      ::  self-authenticated
  (emit %knew /report her wyl)
::
++  poke-recycle                                      ::  save ticket as balance
  |=  {who/mail him-t/knot tik-t/knot}
  ?.  can-recycle.cfg  ~|(%ticket-recycling-offline !!)
  =<  abet
  =.  log-transaction  (log-transaction %recycle +<)
  ?>  =(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))
::   ?^  (scry-womb-invite (shaf %pass pas))
::     ~|(already-recycled+[him-t tik-t] !!)
  =/  inv/{pla/@ud sta/@ud}
    ?+((clan him) !! $duke [0 1], $king [1 0])
  (emit %jaelwomb / %invite pas who inv)
::
::
:: ++  jael-claimed  'Move email here if an ack is necessary'
::
++  poke-claim                                        ::  claim plot, req ticket
  |=  {aut/passcode her/@p}
  ?.  can-claim.cfg  ~|(%ticketing-offline !!)
  =<  abet
  =.  log-transaction  (log-transaction %claim +<)
  ?>  =(src src)
  =/  tik/ticket  (end 6 1 (shas %tick eny))
  =.  emit  (emit %jaelwomb / %claim aut her tik)
  :: XX event crashes work properly yes?
  =/  adr/mail  !!  :: XX scry jael
  (email /ticket adr "Ticket for {<her>}: {<`@pG`tik>}")
::
::
:: ++  poke-release-ships                                ::  release specific
::   |=  a/(list ship)
::   =<  abet  ^+  +>
::   =.  log-transaction  (log-transaction %release-ships +<)
::   ?>  =(our src)                                      ::  privileged
::   %+  roll  a
::   =+  [who=*@p res=+>.$]
::   |.  ^+  res
::   ?+  (clan who)  ~|(bad-size+(clan who) !!)
::     $king  (release-star who res)
::     $czar  (release-galaxy who res)
::   ==
:: ::
:: ++  poke-release                                      ::  release to subdivide
::   |=  {gal/@ud sta/@ud}                               ::
::   =<  abet  ^+  +>
::   =.  log-transaction  (log-transaction %release +<)
::   ?>  =(our src)                                      ::  privileged
::   =.  +>
::     ?~  gal  +>
::     =+  all=(take-n [0 gal] shop-galaxies)
::     ?.  (gth gal (lent all))
::       (roll all release-galaxy)
::     ~|(too-few-galaxies+[want=gal has=(lent all)] !!)
::   ^+  +>
::   ?~  sta  +>
::   =+  all=(take-n [0 sta] shop-stars)
::   ~&  got-stars+all
::   %-  (slog leaf+"For issuing to proceed smoothly, immediately upon boot, ".
::                  "each should |obey {<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))
--