shrub/pkg/arvo/sys/vane/jael.hoon

!:                                                      ::  /vane/jael
::                                                      ::  %reference/0
!?  150
::
::
::  %jael: secrets and promises.
::
::  todo:
::
::    - communication with other vanes:
::      - actually use %behn for expiring secrets
::      - report %ames propagation errors to user
::
::    - nice features:
::      - scry namespace
::      - task for converting invites to tickets
::
|=  our=ship
=,  pki:jael
=,  jael
=,  crypto
=,  jael
=,  ethereum-types
=,  azimuth-types
=,  point=point:jael
::                                                      ::::
::::                    # models                        ::  data structures
  ::                                                    ::::
::  the %jael state comes in two parts: absolute
::  and relative.
::
::  ++state-relative is subjective, denormalized and
::  derived.  it consists of all the state we need to
::  manage subscriptions efficiently.
::
=>  |%
+$  state-1
  $:  %1
      pki=state-pki-1                                   ::
      etn=state-eth-node                                ::  eth connection state
  ==                                                    ::
+$  state-pki-1                                         ::  urbit metadata
  $:  $=  own                                           ::  vault (vein)
        $:  yen=(set duct)                              ::  trackers
            sig=(unit oath)                             ::  for a moon
            tuf=(list turf)                             ::  domains
            boq=@ud                                     ::  boot block
            nod=purl:eyre                               ::  eth gateway
            fak=_|                                      ::  fake keys
            lyf=life                                    ::  version
            step=@ud                                    ::  login code step
            jaw=(map life ring)                         ::  private keys
        ==                                              ::
      $=  zim                                           ::  public
        $:  yen=(jug duct ship)                         ::  trackers
            ney=(jug ship duct)                         ::  reverse trackers
            nel=(set duct)                              ::  trackers of all
            dns=dnses                                   ::  on-chain dns state
            pos=(map ship point)                        ::  on-chain ship state
        ==                                              ::
  ==                                                    ::
+$  message-all
  $%  [%0 message]
  ==
+$  message                                             ::  message to her jael
  $%  [%nuke whos=(set ship)]                           ::  cancel trackers
      [%public-keys whos=(set ship)]                    ::  view ethereum events
  ==                                                    ::
+$  message-result
  $%  [%public-keys-result =public-keys-result]         ::  public keys boon
  ==
+$  card                                                ::  i/o action
  (wind note gift)                                      ::
::                                                      ::
+$  move                                                ::  output
  [p=duct q=card]                                       ::
::                                                      ::
+$  note                                                ::  out request $->
  $~  [%a %plea *ship *plea:ames]                       ::
  $%  $:  %a                                            ::    to %ames
          $>(%plea task:ames)                           ::  send request message
      ==                                                ::
      $:  %b                                            ::    to %behn
          $>(%wait task:behn)                           ::  set timer
      ==                                                ::
      $:  %e                                            ::    to %eyre
          [%code-changed ~]                             ::  notify code changed
      ==                                                ::
      $:  %g                                            ::    to %gall
          $>(%deal task:gall)                           ::  talk to app
      ==                                                ::
      $:  %j                                            ::    to self
          $>(%listen task)                              ::  set ethereum source
      ==                                                ::
      $:  @tas                                          ::
  $%  $>(%init vane-task)                               ::  report install
  ==  ==  ==                                            ::
::                                                      ::
+$  sign                                                ::  in result $<-
  $~  [%behn %wake ~]                                   ::
  $%  $:  %ames                                         ::
          $%  $>(%boon gift:ames)                       ::  message response
              $>(%done gift:ames)                       ::  message (n)ack
              $>(%lost gift:ames)                       ::  lost boon
      ==  ==                                            ::
      $:  %behn                                         ::
          $>(%wake gift:behn)                           ::
      ==                                                ::
      $:  %gall                                         ::
          $>  $?  %onto                                 ::
                  %unto                                 ::
              ==                                        ::
          gift:gall                                ::
      ==
  ==                                                    ::
--  ::
::                                                      ::::
::::                    # light                         ::  light cores
  ::                                                    ::::
=>  |%
::                                                      ::  ++ez
::::                    ## ethereum^light               ::  wallet algebra
  ::                                                    ::::
++  ez
  ::  simple ethereum-related utility arms.
  ::
  |%
  ::
  ::  +order-events: sort changes by block and log numbers
  ::
  ++  order-events
    |=  loz=(list (pair event-id diff-azimuth))
    ^+  loz
    %+  sort  loz
    ::  sort by block number, then by event log number,
    ::TODO  then by diff priority.
    |=  [[[b1=@ud l1=@ud] *] [[b2=@ud l2=@ud] *]]
    ?.  =(b1 b2)  (lth b1 b2)
    ?.  =(l1 l2)  (lth l1 l2)
    &
  --
--
::                                                      ::::
::::                    #  heavy                        ::  heavy engines
  ::                                                    ::::
=>
~%  %jael  ..part  ~
|%
::                                                      ::  ++of
::::                    ## main^heavy                   ::  main engine
  ::                                                    ::::
++  of
  ::  this core handles all top-level %jael semantics,
  ::  changing state and recording moves.
  ::
  ::  logically we could nest the ++su core within it, but
  ::  we keep them separated for clarity.  the ++curd and
  ::  ++cure arms complete relative and absolute effects,
  ::  respectively, at the top level.
  ::
  ::  XX doc
  ::
  ::  a general pattern here is that we use the ++et core
  ::  to generate absolute effects (++change), then invoke
  ::  ++su to calculate the derived effect of these changes.
  ::
  ::  for ethereum-related events, this is preceded by
  ::  invocation of ++et, which produces ethereum-level
  ::  changes (++chain). these get turned into absolute
  ::  effects by ++cute.
  ::
  ::  arvo issues: should be merged with the top-level
  ::  vane interface when that gets cleaned up a bit.
  ::
  =|  moz=(list move)
  =|  $:  $:  ::  now: current time
              ::  eny: unique entropy
              ::
              now=@da
              eny=@uvJ
          ==
          ::  all vane state
          ::
          state-1
      ==
  ::  lex: all durable state
  ::  moz: pending actions
  ::
  =*  lex  ->
  |%
  ::                                                    ::  ++abet:of
  ++  abet                                              ::  resolve
    [(flop moz) lex]
  ::                                                    ::  ++sein:of
  ++  emit
    |=  =move
    +>.$(moz [move moz])
  ::
  ++  poke-watch
    |=  [hen=duct app=term =purl:eyre]
    %-  emit
    :*  hen
        %pass
        /[app]/poke
        %g
        %deal
        [our our]
        app
        %poke
        %azimuth-poke
        !>([%watch (crip (en-purl:html purl))])
    ==
  ::
  ++  sein                                              ::  sponsor
    |=  who=ship
    ^-  ship
    ::  XX save %dawn sponsor in .own.sub, check there
    ::
    =/  pot  (~(get by pos.zim.pki) who)
    ?:  ?&  ?=(^ pot)
            ?=(^ sponsor.u.pot)
        ==
      u.sponsor.u.pot
    (^sein:title who)
  ::                                                    ::  ++saxo:of
  ++  saxo                                              ::  sponsorship chain
    |=  who=ship
    ^-  (list ship)
    =/  dad  (sein who)
    [who ?:(=(who dad) ~ $(who dad))]
  ::                                                    ::  ++call:of
  ++  call                                              ::  invoke
    |=  $:  ::  hen: event cause
            ::  tac: event data
            ::
            hen=duct
            tac=task
        ==
    ^+  +>
    ?-    -.tac
    ::
    ::  boot from keys
    ::    $:  %dawn
    ::        =seed
    ::        spon=ship
    ::        czar=(map ship [=rift =life =pass])
    ::        turf=(list turf)
    ::        bloq=@ud
    ::        node=purl
    ::    ==
    ::
        %dawn
      ::  single-homed
      ::
      ~|  [our who.seed.tac]
      ?>  =(our who.seed.tac)
      ::  save our boot block
      ::
      =.  boq.own.pki  bloq.tac
      ::  save our ethereum gateway (required for galaxies)
      ::
      =.  nod.own.pki
        %+  fall  node.tac
        (need (de-purl:html 'http://eth-mainnet.urbit.org:8545'))
      ::  save our parent signature (only for moons)
      ::
      =.  sig.own.pki  sig.seed.tac
      ::  load our initial public key
      ::
      =/  spon-ship=(unit ship)
        =/  flopped-spon  (flop spon.tac)
        ?~(flopped-spon ~ `ship.i.flopped-spon)
      =.  pos.zim.pki
        =/  cub  (nol:nu:crub:crypto key.seed.tac)
        %+  ~(put by pos.zim.pki)
          our
        [0 lyf.seed.tac (my [lyf.seed.tac [1 pub:ex:cub]] ~) spon-ship]
      ::  our initial private key
      ::
      =.  lyf.own.pki  lyf.seed.tac
      =.  jaw.own.pki  (my [lyf.seed.tac key.seed.tac] ~)
      ::  XX save sponsor in .own.pki
      ::  XX reconcile with .dns.eth
      ::  set initial domains
      ::
      =.  tuf.own.pki  turf.tac
      ::  our initial galaxy table as a +map from +life to +public
      ::
      =/  spon-points=(list [ship point])
        %+  turn  spon.tac
        |=  [=ship az-point=point:azimuth-types]
        ~|  [%sponsor-point az-point]
        ?>  ?=(^ net.az-point)
        :*  ship
            continuity-number.u.net.az-point
            life.u.net.az-point
            (malt [life.u.net.az-point 1 pass.u.net.az-point] ~)
            ?.  has.sponsor.u.net.az-point
              ~
            `who.sponsor.u.net.az-point
        ==
      =/  points=(map =ship =point)
        %-  ~(run by czar.tac)
        |=  [=a=rift =a=life =a=pass]
        ^-  point
        [a-rift a-life (malt [a-life 1 a-pass] ~) ~]
      =.  points
        (~(gas by points) spon-points)
      =.  +>.$
        %-  curd  =<  abet
        (public-keys:~(feel su hen now pki etn) pos.zim.pki %full points)
      ::
      ::  start subscriptions
      ::
      =.  +>.$  (poke-watch hen %azimuth nod.own.pki)
      =.  +>.$
        ::  get everything from azimuth-tracker because jael subscriptions
        ::  seem to be flaky for now
        ::
        ?:  &
          %-  curd  =<  abet
          (sources:~(feel su hen now pki etn) ~ [%| %azimuth])
        ::
        ?-    (clan:title our)
            %czar
          %-  curd  =<  abet
          (sources:~(feel su hen now pki etn) ~ [%| %azimuth])
        ::
            *
          =.  +>.$
            %-  curd  =<  abet
            %+  sources:~(feel su hen now pki etn)
              (silt (turn spon-points head))
            [%| %azimuth]
          %-  curd  =<  abet
          (sources:~(feel su hen now pki etn) ~ [%& (need spon-ship)])
        ==
      ::
      =.  moz
        %+  weld  moz
        ::  order is crucial!
        ::
        ::    %dill must init after %gall
        ::    the %give init (for unix) must be after %dill init
        ::    %jael init must be deferred (makes http requests)
        ::
        ^-  (list move)
        :~  [hen %slip %e %init ~]
            [hen %slip %d %init ~]
            [hen %slip %g %init ~]
            [hen %slip %c %init ~]
            [hen %slip %a %init ~]
        ==
      +>.$
    ::
    ::  boot fake
    ::    [%fake =ship]
    ::
        %fake
      ::  single-homed
      ::
      ?>  =(our ship.tac)
      ::  fake keys are deterministically derived from the ship
      ::
      =/  cub  (pit:nu:crub:crypto 512 our)
      ::  our initial public key
      ::
      =.  pos.zim.pki
        %+  ~(put by pos.zim.pki)
          our
        [rift=1 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
      ::  our private key
      ::
      ::    Private key updates are disallowed for fake ships,
      ::    so we do this first.
      ::
      =.  lyf.own.pki  1
      =.  jaw.own.pki  (my [1 sec:ex:cub] ~)
      ::  set the fake bit
      ::
      =.  fak.own.pki  &
      ::  initialize other vanes per the usual procedure
      ::
      ::    Except for ourselves!
      ::
      =.  moz
        %+  weld  moz
        ^-  (list move)
        :~  [hen %slip %e %init ~]
            [hen %slip %d %init ~]
            [hen %slip %g %init ~]
            [hen %slip %c %init ~]
            [hen %slip %a %init ~]
        ==
      +>.$
    ::
    ::  set ethereum source
    ::    [%listen whos=(set ship) =source]
    ::
        %listen
      ~&  [%jael-listen whos source]:tac
      %-  curd  =<  abet
      (sources:~(feel su hen now pki etn) [whos source]:tac)
    ::
    ::  cancel all trackers from duct
    ::    [%nuke whos=(set ship)]
    ::
        %nuke
      =/  ships=(list ship)
        %~  tap  in
        %-  ~(int in whos.tac)
        (~(get ju yen.zim.pki) hen)
      =.  ney.zim.pki
        |-  ^-  (jug ship duct)
        ?~  ships
          ney.zim.pki
        (~(del ju $(ships t.ships)) i.ships hen)
      =.  yen.zim.pki
        |-  ^-  (jug duct ship)
        ?~  ships
          yen.zim.pki
        (~(del ju $(ships t.ships)) hen i.ships)
      =?  nel.zim.pki  ?=(~ whos.tac)
        (~(del in nel.zim.pki) hen)
      ?^  whos.tac
        +>.$
      %_  +>.$
        yen.own.pki  (~(del in yen.own.pki) hen)
      ==
    ::
    ::  update private keys
    ::
        %rekey
      %-  curd  =<  abet
      (private-keys:~(feel su hen now pki etn) life.tac ring.tac)
    ::
    ::  register moon keys
    ::
        %moon
      ?.  =(%earl (clan:title ship.tac))
        ~&  [%not-moon ship.tac]
        +>.$
      ?.  =(our (^sein:title ship.tac))
        ~&  [%not-our-moon ship.tac]
        +>.$
      %-  curd  =<  abet
      (~(new-event su hen now pki etn) [ship udiff]~:tac)
    ::
    ::  rotate web login code
    ::
        %step
      %=  +>.$
        step.own.pki  +(step.own.pki)
        moz           [[hen %pass / %e %code-changed ~] moz]
      ==
    ::
    ::  watch public keys
    ::    [%public-keys ships=(set ship)]
    ::
        %public-keys
      %-  curd  =<  abet
      (~(public-keys ~(feed su hen now pki etn) hen) ships.tac)
    ::
    ::  seen after breach
    ::    [%meet our=ship who=ship]
    ::
        %meet
      +>.$
    ::
    ::  XX should be a subscription
    ::  XX reconcile with .dns.eth
    ::  request domains
    ::    [%turf ~]
    ::
        %turf
      ::  ships with real keys must have domains,
      ::  those with fake keys must not
      ::
      ~|  [fak.own.pki tuf.own.pki]
      ?<  =(fak.own.pki ?=(^ tuf.own.pki))
      +>.$(moz [[hen %give %turf tuf.own.pki] moz])
    ::
    ::  learn of kernel upgrade
    ::    [%vega ~]
    ::
        %vega
      +>.$::
    ::  in response to memory pressure
    ::    [%trim p=@ud]
    ::
        %trim
      +>.$
    ::
    ::  watch private keys
    ::    [%private-keys ~]
    ::
        %private-keys
      (curd abet:~(private-keys ~(feed su hen now pki etn) hen))
    ::
    ::  authenticated remote request
    ::    [%west p=ship q=path r=*]
    ::
        %plea
      =*  her  ship.tac
      =+  ;;(=message-all payload.plea.tac)
      ?>  ?=(%0 -.message-all)
      =/  =message  +.message-all
      ?-    -.message
      ::
      ::  cancel trackers
      ::    [%nuke whos=(set ship)]
      ::
          %nuke
        =.  moz  [[hen %give %done ~] moz]
        $(tac message)
      ::
      ::  view ethereum events
      ::    [%public-keys whos=(set ship)]
      ::
          %public-keys
        =.  moz  [[hen %give %done ~] moz]
        $(tac message)
      ==
    ==
  ::
  ++  take
    |=  [tea=wire hen=duct hin=sign]
    ^+  +>
    ?-  hin
        [%ames %done *]
      ?~  error.hin  +>.$
      ~&  [%done-bad tag.u.error.hin]
      %-  (slog tang.u.error.hin)
      ::TODO  fail:et
      +>.$
    ::
        [%ames %boon *]
      =+  ;;  [%public-keys-result =public-keys-result]  payload.hin
      %-  curd  =<  abet
      (public-keys:~(feel su hen now pki etn) pos.zim.pki public-keys-result)
    ::
        [%ames %lost *]
      ::  TODO: better error handling
      ::
      ~|  %jael-ames-lost
      !!
    ::
        [%behn %wake *]
      ?^  error.hin
        %-  %+  slog
              leaf+"jael unable to resubscribe, run :azimuth-tracker|listen"
            u.error.hin
          +>.$
      ?>  ?=([%breach @ ~] tea)
      =/  =source-id  (slav %ud i.t.tea)
      =/  =source  (~(got by sources.etn) source-id)
      =/  ships  (~(get ju ship-sources-reverse.etn) source-id)
      %-  curd  =<  abet
      (sources:~(feel su hen now pki etn) ships source)
    ::
        [%gall %onto *]
      ~&  [%jael-onto tea hin]
      +>.$
    ::
        [%gall %unto *]
      ?-    +>-.hin
          %raw-fact  !!
          %kick      ~|([%jael-unexpected-quit tea hin] !!)
          %poke-ack
        ?~  p.p.+>.hin
          +>.$
        %-  (slog leaf+"jael-bad-coup" u.p.p.+>.hin)
        +>.$
      ::
          %watch-ack
        ?~  p.p.+>.hin
          +>.$
        %-  (slog u.p.p.+>.hin)
        ~|([%jael-unexpected-reap tea hin] +>.$)
      ::
          %fact
        ?>  ?=([@ *] tea)
        =*  app  i.tea
        =+  ;;(=udiffs:point q.q.cage.p.+>.hin)
        %-  curd  =<  abet
        (~(new-event su hen now pki etn) udiffs)
      ==
    ==
  ::                                                    ::  ++curd:of
  ++  curd                                              ::  relative moves
    |=  $:  moz=(list move)
            pki=state-pki-1
            etn=state-eth-node
        ==
    +>(pki pki, etn etn, moz (weld (flop moz) ^moz))
  --
::                                                      ::  ++su
::::                    ## relative^heavy               ::  subjective engine
  ::                                                    ::::
++  su
      ::  the ++su core handles all derived state,
      ::  subscriptions, and actions.
      ::
      ::  ++feed:su registers subscriptions.
      ::
      ::  ++feel:su checks if a ++change should notify
      ::  any subscribers.
      ::
  =|  moz=(list move)
  =|  $:  hen=duct
          now=@da
          state-pki-1
          state-eth-node
      ==
  ::  moz: moves in reverse order
  ::  pki: relative urbit state
  ::
  =*  pki  ->+<
  =*  etn  ->+>
  |%
  ++  this-su  .
  ::                                                    ::  ++abet:su
  ++  abet                                              ::  resolve
    [(flop moz) pki etn]
  ::                                                    ::  ++exec:su
  ++  emit
    |=  =move
    +>.$(moz [move moz])
  ::
  ++  exec                                              ::  mass gift
    |=  [yen=(set duct) cad=card]
    =/  noy  ~(tap in yen)
    |-  ^+  this-su
    ?~  noy  this-su
    $(noy t.noy, moz [[i.noy cad] moz])
  ::
  ++  emit-peer
    |=  [app=term =path]
    %-  emit
    :*  hen
        %pass
        [app path]
        %g
        %deal
        [our our]
        app
        %watch
        path
    ==
  ::
  ++  peer
    |=  [app=term whos=(set ship)]
    ?:  =(~ whos)
      (emit-peer app /)
    =/  whol=(list ship)  ~(tap in whos)
    |-  ^+  this-su
    ?~  whol  this-su
    =.  this-su  (emit-peer app /(scot %p i.whol))
    $(whol t.whol)
  ::
  ++  public-keys-give
    |=  [yen=(set duct) =public-keys-result]
    |^
    =+  yez=(sort ~(tap in yen) sorter)
    |-  ^+  this-su
    ?~  yez  this-su
    =*  d  i.yez
    =.  this-su
      ?.  &(?=([[%ames @ @ *] *] d) !=(%public-keys i.t.i.d))
        %-  emit
        [d %give %public-keys public-keys-result]
      %-  emit
      [d %give %boon %public-keys-result public-keys-result]
    $(yez t.yez)
    ::
    ::  We want to notify Ames, then Clay, then Gall.  This happens to
    ::  be alphabetical, but this is mostly a coincidence.
    ::
    ++  sorter
      |=  [a=duct b=duct]
      ?.  ?=([[@ *] *] a)
        |
      ?.  ?=([[@ *] *] b)
        &
      (lth (end 3 i.i.a) (end 3 i.i.b))
    --
  ::
  ++  get-source
    |=  who=@p
    ^-  source
    =/  ship-source  (~(get by ship-sources.etn) who)
    ?^  ship-source
      (~(got by sources) u.ship-source)
    ?:  =((clan:title who) %earl)
      [%& (^sein:title who)]
    (~(got by sources) default-source.etn)
  ::
  ++  get-source-id
    |=  =source
    ^-  [source-id _this-su]
    =/  source-reverse  (~(get by sources-reverse) source)
    ?^  source-reverse
      [u.source-reverse this-su]
    :-  top-source-id.etn
    %_  this-su
      top-source-id.etn    +(top-source-id.etn)
      sources.etn          (~(put by sources) top-source-id.etn source)
      sources-reverse.etn  (~(put by sources-reverse) source top-source-id.etn)
    ==
  ::
  ++  new-event
    |=  =udiffs:point
    ^+  this-su
    =/  original-pos  pos.zim.pki
    |-  ^+  this-su
    ?~  udiffs
      this-su
    =/  a-point=point  (~(gut by pos.zim.pki) ship.i.udiffs *point)
    =/  a-diff=(unit diff:point)  (udiff-to-diff:point udiff.i.udiffs a-point)
    =?  this-su  ?=(^ a-diff)
      ::  if this about our keys, and we already know these, start using them
      ::
      =?  lyf.own
          ?&  =(our ship.i.udiffs)
              ?=(%keys -.u.a-diff)
              (~(has by jaw.own) life.to.u.a-diff)
          ==
        life.to.u.a-diff
      (public-keys:feel original-pos %diff ship.i.udiffs u.a-diff)
    $(udiffs t.udiffs)
  ::
  ++  subscribers-on-ship
    |=  =ship
    ^-  (set duct)
    =/  specific-subs  (~(get ju ney.zim) ship)
    =/  general-subs=(set duct)
      ?:  ?=(?(%czar %king %duke) (clan:title ship))
        nel.zim
      ~
    (~(uni in specific-subs) general-subs)
  ::
  ++  feed
    |_  ::  hen: subscription source
        ::
        hen=duct
    ::
    ::  Handle subscription to public-keys
    ::
    ++  public-keys
      |=  whos=(set ship)
      ?:  fak.own.pki
        (public-keys:fake whos)
      ::  Subscribe to parent of moons
      ::
      =.  ..feed
        =/  moons=(jug ship ship)
          %-  ~(gas ju *(jug spon=ship who=ship))
          %+  murn  ~(tap in whos)
          |=  who=ship
          ^-  (unit [spon=ship child=ship])
          ?.  =(%earl (clan:title who))
            ~
          ?:  (~(has by ship-sources) who)
            ~
          `[(^sein:title who) who]
        =/  moonl=(list [spon=ship ships=(set ship)])
          ~(tap by moons)
        |-  ^+  ..feed
        ?~  moonl
          ..feed
        ?:  =(our spon.i.moonl)
          $(moonl t.moonl)
        =.  ..feed  (sources:feel ships.i.moonl [%& spon.i.moonl])
        $(moonl t.moonl)
      ::  Add to subscriber list
      ::
      =.  ney.zim
        =/  whol=(list ship)  ~(tap in whos)
        |-  ^-  (jug ship duct)
        ?~  whol
          ney.zim
        (~(put ju $(whol t.whol)) i.whol hen)
      =.  yen.zim
        %-  ~(gas ju yen.zim)
        %+  turn  ~(tap in whos)
        |=  who=ship
        [hen who]
      =?  nel.zim  ?=(~ whos)
        (~(put in nel.zim) hen)
      ::  Give initial result
      ::
      =/  =public-keys-result
        :-  %full
        ?:  =(~ whos)
          pos.zim
        %-  my  ^-  (list (pair ship point))
        %+  murn
          ~(tap in whos)
        |=  who=ship
        ^-  (unit (pair ship point))
        =/  pub  (~(get by pos.zim) who)
        ?~  pub  ~
        ?:  =(0 life.u.pub)  ~
        `[who u.pub]
      =.  ..feed  (public-keys-give (sy hen ~) public-keys-result)
      ..feed
    ::
    ::  Handle subscription to private-keys
    ::
    ++  private-keys
      %_  ..feed
        moz      [[hen %give %private-keys [lyf jaw]:own] moz]
        yen.own  (~(put in yen.own) hen)
      ==
    ::
    ++  fake
      ?>  fak.own.pki
      |%
      ++  public-keys
        |=  whos=(set ship)
        =/  whol=(list ship)  ~(tap in whos)
        =/  passes
          |-  ^-  (list [who=ship =pass])
          ?~  whol
            ~
          =/  cub  (pit:nu:crub:crypto 512 i.whol)
          :-  [i.whol pub:ex:cub]
          $(whol t.whol)
        =/  points=(list (pair ship point))
          %+  turn  passes
          |=  [who=ship =pass]
          ^-  [who=ship =point]
          [who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
        =.  moz  [[hen %give %public-keys %full (my points)] moz]
        ..feel
      --
    --
  ::
  ++  feel
    |%
    ::
    ::  Update public-keys
    ::
    ++  public-keys
      |=  [original=(map ship point) =public-keys-result]
      ^+  ..feel
      ?:  ?=(%full -.public-keys-result)
        =/  pointl=(list [who=ship =point])
          ~(tap by points.public-keys-result)
        |-  ^+  ..feel
        ?~  pointl
          ..feel(pos.zim (~(uni by pos.zim) points.public-keys-result))
        ::  if changing rift upward and we already had keys for them,
        ::  then signal a breach
        ::
        =?    ..feel
            =/  point
              (~(get by pos.zim) who.i.pointl)
            ?&  (~(has by original) who.i.pointl)
                ?=(^ point)
                (gth rift.point.i.pointl rift.u.point)
            ==
          =.  ..feel
            %+  public-keys-give
              (subscribers-on-ship who.i.pointl)
            [%breach who.i.pointl]
          =/  sor  (~(get by sources-reverse) %& who.i.pointl)
          ?~  sor
            ..feel
          ::  delay resubscribing because Ames is going to clear any
          ::  messages we send now.
          ::
          (emit hen %pass /breach/(scot %ud u.sor) %b %wait now)
        ::
        =.  ..feel
          %+  public-keys-give
            (subscribers-on-ship who.i.pointl)
          [%full (my i.pointl ~)]
        $(pointl t.pointl)
      ::
      ?:  ?=(%breach -.public-keys-result)
        ::  we calculate our own breaches based on our local state
        ::
        ..feel
      =*  who  who.public-keys-result
      =/  a-diff=diff:point  diff.public-keys-result
      =/  maybe-point  (~(get by pos.zim) who)
      =/  =point  (fall maybe-point *point)
      ::  if changing rift upward and we already had keys for them, then
      ::  signal a breach
      ::
      =?    ..feel
          ?&  (~(has by original) who)
              ?=(^ maybe-point)
              ?=(%rift -.a-diff)
              (gth to.a-diff rift.point)
          ==
        =.  ..feel
          %+  public-keys-give
            (subscribers-on-ship who)
          [%breach who]
        =/  sor  (~(get by sources-reverse) %& who)
        ?~  sor
          ..feel
        ::  delay resubscribing because Ames is going to clear any
        ::  messages we send now.
        ::
        (emit hen %pass /breach/(scot %ud u.sor) %b %wait now)
      ::
      =.  point
        ?-  -.a-diff
            %spon  point(sponsor to.a-diff)
            %rift  point(rift to.a-diff)
            %keys
          %_  point
              life  life.to.a-diff
              keys
            %+  ~(put by keys.point)
              life.to.a-diff
            [crypto-suite pass]:to.a-diff
          ==
        ==
      ::
      =.  pos.zim  (~(put by pos.zim) who point)
      %+  public-keys-give
        (subscribers-on-ship who)
      ?~  maybe-point
        [%full (my [who point]~)]
      [%diff who a-diff]
    ::
    ::  Update private-keys
    ::
    ++  private-keys
      |=  [=life =ring]
      ^+  ..feel
      ?:  &(=(lyf.own life) =((~(get by jaw.own) life) `ring))
        ..feel
      ::  only eagerly update lyf if we were behind the chain life
      ::
      =?  lyf.own
          ?|  ?=(%earl (clan:title our))
              ?&  (gth life lyf.own)
                ::
                  =+  pon=(~(get by pos.zim) our)
                  ?~  pon  |
                  (lth lyf.own life.u.pon)
          ==  ==
        life
      =.  jaw.own  (~(put by jaw.own) life ring)
      (exec yen.own [%give %private-keys lyf.own jaw.own])
    ::
    ::  Change sources for ships
    ::
    ++  sources
      |=  [whos=(set ship) =source]
      ^+  ..feel
      =^  =source-id  this-su  (get-source-id source)
      =.  ..feed
        ?~  whos
          ..feed(default-source.etn source-id)
        =/  whol=(list ship)  ~(tap in `(set ship)`whos)
        =.  ship-sources.etn
          |-  ^-  (map ship ^source-id)
          ?~  whol
            ship-sources.etn
          (~(put by $(whol t.whol)) i.whol source-id)
        =.  ship-sources-reverse.etn
          %-  ~(gas ju ship-sources-reverse.etn)
          (turn whol |=(=ship [source-id ship]))
        ..feed
      ::
      ?:  ?=(%& -.source)
        %-  emit
        =/  =message-all  [%0 %public-keys whos]
        [hen %pass /public-keys %a %plea p.source %j /public-keys message-all]
      (peer p.source whos)
    --
  ::
  ::  No-op
  ::
  ++  meet
    |=  [who=ship =life =pass]
    ^+  +>
    +>.$
  --
--
::                                                      ::::
::::                    #  vane                         ::  interface
  ::                                                    ::::
::
::  lex: all durable %jael state
::
=|  lex=state-1
|=  $:  ::  now: current time
        ::  eny: unique entropy
        ::  ski: namespace resolver
        ::
        now=@da
        eny=@uvJ
        rof=roof
    ==
^?
|%
::                                                      ::  ++call
++  call                                                ::  request
  |=  $:  ::  hen: cause of this event
          ::  hic: event data
          ::
          hen=duct
          dud=(unit goof)
          hic=(hobo task)
      ==
  ^-  [(list move) _..^$]
  ?^  dud
    ~|(%jael-call-dud (mean tang.u.dud))
  ::
  =/  =task  ((harden task) hic)
  =^  did  lex
    abet:(~(call of [now eny] lex) hen task)
  [did ..^$]
::                                                      ::  ++load
++  load                                                ::  upgrade
  |=  old=state-1
  ^+  ..^$
  ..^$(lex old)
::                                                      ::  ++scry
++  scry                                                ::  inspect
  ^-  roon
  |=  [lyc=gang car=term bem=beam]
  ^-  (unit (unit cage))
  =*  ren  car
  =*  why=shop  &/p.bem
  =*  syd  q.bem
  =*  lot=coin  $/r.bem
  =*  tyl  s.bem
  ::
  ::  XX review for security, stability, cases other than now
  ::
  ?.  =(lot [%$ %da now])  ~
  ?.  =(%$ ren)  [~ ~]
  ?:  =(tyl /whey)
    =/  maz=(list mass)
      :~  pki+&+pki.lex
          etn+&+etn.lex
      ==
    ``mass+!>(maz)
  ?+    syd
      ~
  ::
      %step
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    ``[%noun !>(step.own.pki.lex)]
  ::
      %code
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    =/  sec  (~(got by jaw.own.pki.lex) lyf.own.pki.lex)
    =/  sal  (add %pass step.own.pki.lex)
    ``[%noun !>((end 6 (shaf sal (shax sec))))]
  ::
      %life
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    ::  fake ships always have life=1
    ::
    ?:  fak.own.pki.lex
      ``[%atom !>(1)]
    ?:  =(u.who p.why)
      ``[%atom !>(lyf.own.pki.lex)]
    =/  pub  (~(get by pos.zim.pki.lex) u.who)
    ?~  pub  ~
    ``[%atom !>(life.u.pub)]
  ::
      %lyfe                                             ::  unitized %life
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    ::  fake ships always have life=1
    ::
    ?:  fak.own.pki.lex
      ``[%noun !>((some 1))]
    ?:  =(u.who p.why)
      ``[%noun !>((some lyf.own.pki.lex))]
    =/  pub  (~(get by pos.zim.pki.lex) u.who)
    ?~  pub  ``[%noun !>(~)]
    ``[%noun !>((some life.u.pub))]
  ::
      %rift
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    ::  fake ships always have rift=1
    ::
    ?:  fak.own.pki.lex
      ``[%atom !>(1)]
    =/  pos  (~(get by pos.zim.pki.lex) u.who)
    ?~  pos  ~
    ``[%atom !>(rift.u.pos)]
  ::
      %ryft                                             ::  unitized %rift
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    ::  fake ships always have rift=1
    ::
    ?:  fak.own.pki.lex
      ``[%noun !>((some 1))]
    =/  pos  (~(get by pos.zim.pki.lex) u.who)
    ?~  pos  ``[%noun !>(~)]
    ``[%noun !>((some rift.u.pos))]
  ::
      %vein
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  &(?=(%& -.why) =(p.why our))
      [~ ~]
    =/  lyf  (slaw %ud i.tyl)
    ?~  lyf  [~ ~]
    ::
    ?~  r=(~(get by jaw.own.pki.lex) u.lyf)
      [~ ~]
    ::
    [~ ~ %noun !>(u.r)]
  ::
      %vile
    =*   life  lyf.own.pki.lex
    =/  =seed  [our life (~(got by jaw.own.pki.lex) life) ~]
    [~ ~ %atom !>((jam seed))]
  ::
      %deed
    ?.  ?=([@ @ ~] tyl)  [~ ~]
    ?.  &(?=(%& -.why) =(p.why our))
      [~ ~]
    =/  who  (slaw %p i.tyl)
    =/  lyf  (slaw %ud i.t.tyl)
    ?~  who  [~ ~]
    ?~  lyf  [~ ~]
    ::
    ?:  fak.own.pki.lex
      =/  cub  (pit:nu:crub:crypto 512 u.who)
      :^  ~  ~  %noun
      !>  [1 pub:ex:cub ~]
    ::
    =/  rac  (clan:title u.who)
    ?:  ?=(%pawn rac)
      ?.  =(u.who p.why)
        [~ ~]
      ?.  =(1 u.lyf)
        [~ ~]
      =/  sec  (~(got by jaw.own.pki.lex) u.lyf)
      =/  cub  (nol:nu:crub:crypto sec)
      =/  sig  (sign:as:cub (shaf %self (sham [u.who 1 pub:ex:cub])))
      :^  ~  ~  %noun
      !>  [1 pub:ex:cub `sig]
    ::
    =/  pub  (~(get by pos.zim.pki.lex) u.who)
    ?~  pub
      ~
    ?:  (gth u.lyf life.u.pub)
      ~
    =/  pas  (~(get by keys.u.pub) u.lyf)
    ?~  pas
      ~
    :^  ~  ~  %noun
    !>  [u.lyf pass.u.pas ~]
  ::
      %earl
    ?.  ?=([@ @ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    =/  lyf  (slaw %ud i.t.tyl)
    ?~  who  [~ ~]
    ?~  lyf  [~ ~]
    ?:  (gth u.lyf lyf.own.pki.lex)
      ~
    ?:  (lth u.lyf lyf.own.pki.lex)
      [~ ~]
    :: XX check that who/lyf hasn't been booted
    ::
    =/  sec  (~(got by jaw.own.pki.lex) u.lyf)
    =/  moon-sec  (shaf %earl (sham our u.lyf sec u.who))
    =/  cub  (pit:nu:crub:crypto 128 moon-sec)
    =/  =seed  [u.who 1 sec:ex:cub ~]
    ``[%seed !>(seed)]
  ::
      %sein
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    :^  ~  ~  %atom
    !>  ^-  ship
    (~(sein of [now eny] lex) u.who)
  ::
      %saxo
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    =/  who  (slaw %p i.tyl)
    ?~  who  [~ ~]
    :^  ~  ~  %noun
    !>  ^-  (list ship)
    (~(saxo of [now eny] lex) u.who)
  ::
      %subscriptions
    ?.  ?=([@ ~] tyl)  [~ ~]
    ?.  =([%& our] why)
      [~ ~]
    :^  ~  ~  %noun
    !>([yen ney nel]:zim.pki.lex)
  ::
      %sources
    ?.  ?=(~ tyl)  [~ ~]
    :^  ~  ~  %noun  !>
    etn.lex
  ::
      %turf
    ?.  ?=(~ tyl)  [~ ~]
    [~ ~ %noun !>(tuf.own.pki.lex)]
  ==
::                                                      ::  ++stay
++  stay                                                ::  preserve
  lex
::                                                      ::  ++take
++  take                                                ::  accept
  |=  $:  ::  tea: order
          ::  hen: cause
          ::  hin: result
          ::
          tea=wire
          hen=duct
          dud=(unit goof)
          hin=sign
      ==
  ^-  [(list move) _..^$]
  ?^  dud
    ~|(%jael-take-dud (mean tang.u.dud))
  ::
  =^  did  lex  abet:(~(take of [now eny] lex) tea hen hin)
  [did ..^$]
--