urbit/pkg/arvo/app/dbug.hoon

::  dbug: debug dashboard server
::
/-  spider
/+  server, default-agent, verb, dbug
::
|%
+$  state-0  [%0 passcode=(unit @t)]
+$  card  card:agent:gall
--
::
=|  state-0
=*  state  -
::
%+  verb  |
%-  agent:dbug
^-  agent:gall
=<
  |_  =bowl:gall
  +*  this  .
      do    ~(. +> bowl)
      def   ~(. (default-agent this %|) bowl)
  ::
  ++  on-init
    ^-  (quip card _this)
    :_  this
    [%pass /connect %arvo %e %connect [~ /'~debug'] dap.bowl]~
  ::
  ++  on-save  !>(state)
  ::
  ++  on-load
    |=  old=vase
    ^-  (quip card _this)
    [~ this(state !<(state-0 old))]
  ::
  ++  on-watch
    |=  =path
    ^-  (quip card _this)
    ?.  ?=([%http-response *] path)
      (on-watch:def path)
    [~ this]
  ::
  ++  on-poke
    |=  [=mark =vase]
    ^-  (quip card _this)
    ?:  ?=(%noun mark)
      ?>  (team:title [our src]:bowl)
      =/  code  !<((unit @t) vase)
      =/  msg=tape
        ?~  code
          "Removing passcode access for debug interface."
        """
        Enabling passcode access for debug interface. Anyone with this code can
         view your applications' state, the people you've talked to, etc. Only
         share with people you trust. To disable, run :dbug ~
        """
      %-  (slog leaf+msg ~)
      [~ this(passcode code)]
    ?.  ?=(%handle-http-request mark)
      (on-poke:def mark vase)
    =+  !<([eyre-id=@ta =inbound-request:eyre] vase)
    :_  this
    %+  give-simple-payload:app:server  eyre-id
    %+  authorize-http-request:do  inbound-request
    handle-http-request:do
  ::
  ++  on-arvo
    |=  [=wire =sign-arvo]
    ^-  (quip card _this)
    ?.  ?=([%e %bound *] sign-arvo)
      (on-arvo:def wire sign-arvo)
    ~?  !accepted.sign-arvo
      [dap.bowl "bind rejected!" binding.sign-arvo]
    [~ this]
  ::
  ++  on-peek   on-peek:def
  ++  on-leave  on-leave:def
  ++  on-agent  on-agent:def
  ++  on-fail   on-fail:def
  --
::
|_  =bowl:gall
::
::  serving
::
++  authorize-http-request
  =,  server
  ::  if no passcode configured, only allow host ship to view
  ::
  ?~  passcode  require-authorization:app
  |=  $:  =inbound-request:eyre
          handler=$-(inbound-request:eyre simple-payload:http)
      ==
  ?:  authenticated.inbound-request
    (handler inbound-request)
  ::  else, allow randos access,
  ::  on the condition they provide a correct ?passcode= url parameter
  ::
  =;  pass=(unit @t)
    ?:  =(passcode pass)
      (handler inbound-request)
    (require-authorization:app inbound-request handler)
  =/  from-url=(unit @t)
    =-  (~(get by -) 'passcode')
    %-  ~(gas by *(map @t @t))
    args:(parse-request-line url.request.inbound-request)
  ?^  from-url  from-url
  ::  try the referer field instead
  ::
  =/  ref-url=(unit @t)
    (get-header:http 'referer' header-list.request.inbound-request)
  ?~  ref-url  ~
  ?~  (find "passcode={(trip u.passcode)}" (trip u.ref-url))  ~
  passcode
::
++  handle-http-request
  =,  server
  |=  =inbound-request:eyre
  ^-  simple-payload:http
  =/  =request-line
    %-  parse-request-line
    url.request.inbound-request
  =*  req-head  header-list.request.inbound-request
  ::TODO  handle POST
  ?.  ?=(%'GET' method.request.inbound-request)
    not-found:gen
  (handle-get-request req-head request-line)
::
++  handle-get-request
  =,  server
  |=  [headers=header-list:http request-line]
  ^-  simple-payload:http
  =?  site  ?=([%'~debug' *] site)  t.site
  ?~  ext
    $(ext `%html, site [%index ~]) ::NOTE  hack
  ::  if not json, serve static file
  ::
  ?.  ?=([~ %json] ext)
    =/  file=(unit octs)
      (get-file-at /app/debug site u.ext)
    ?~  file  not-found:gen
    ?+  u.ext  not-found:gen
      %html  (html-response:gen u.file)
      %js    (js-response:gen u.file)
      %css   (css-response:gen u.file)
      %png   (png-response:gen u.file)
    ==
  ::  get data matching the json and convert it
  ::
  =;  json=(unit json)
    ?~  json  not-found:gen
    %-  json-response:gen
    =,  html
    (as-octt:mimes (en-json u.json))
  =,  enjs:format
  ?+  site  ~
    ::  /apps.json: {appname: running?}
    ::
      [%apps ~]
    %-  some
    %-  pairs
    %+  turn  all:apps
    |=  app=term
    [app b+(running:apps app)]
  ::
    ::  /app/[appname]...
    ::
      [%app @ *]
    =*  app  i.t.site
    ::TODO  ?.  (dbugable:apps app)  ~
    =/  rest=^path  t.t.site
    ?+  rest  ~
      ::  /app/[appname].json: {state: }
      ::
        ~
      %-  some
      %-  pairs
      :~  :-  'simpleState'
          %-  tank
          =;  head=(unit ^tank)
            (fall head leaf+"unversioned")
          ::  try to print the state version
          ::
          =/  version=(unit vase)
            (slew 2 (state:apps app))
          ?~  version  ~
          ?.  ?=(%atom -.p.u.version)  ~
          `(sell u.version)
        ::
          :-  'subscriptions'
          %-  pairs
          =+  (subscriptions:apps app)
          |^  ~['in'^(incoming in) 'out'^(outgoing out)]
          ::
          ++  incoming
            |=  =bitt:gall
            ^-  json
            :-  %a
            %+  turn  ~(tap by bitt)
            |=  [d=duct [s=^ship p=^path]]
            %-  pairs
            :~  'duct'^a+(turn d path)
                'ship'^(ship s)
                'path'^(path p)
            ==
          ::
          ++  outgoing
            |=  =boat:gall
            ^-  json
            :-  %a
            %+  turn  ~(tap by boat)
            |=  [[w=wire s=^ship t=term] [a=? p=^path]]
            %-  pairs
            :~  'wire'^(path w)
                'ship'^(ship s)
                'app'^s+t
                'acked'^b+a
                'path'^(path p)
            ==
          --
      ==
    ::
      ::  /app/[appname]/state.json
      ::  /app/[appname]/state/[query].json
      ::
        [%state ?(~ [@ ~])]
      %-  some
      =-  (pairs 'state'^(tank -) ~)
      %+  state-at:apps  app
      ?~  t.rest  ~
      (slaw %t i.t.rest)
    ==
  ::
    ::  /spider.json
    ::
      [%spider %threads ~]
    %-  some
    ::  turn flat stack descriptors into object (tree) representing stacks
    ::
    |^  (tree-to-json build-thread-tree)
    ::
    +$  tree
      $~  ~
      (map tid:spider tree)
    ::
    ++  build-thread-tree
      %+  roll  tree:threads
      |=  [stack=(list tid:spider) =tree]
      ?~  stack  tree
      %+  ~(put by tree)  i.stack
      %_  $
        stack  t.stack
        tree   (~(gut by tree) i.stack ~)
      ==
    ::
    ++  tree-to-json
      |=  =tree
      o+(~(run by tree) tree-to-json)
    --
  ::
    ::  /azimuth/status
  ::
    ::  /ames/peer.json
    ::
      [%ames %peer ~]
    =/  [known=(list [^ship *]) alien=(list [^ship *])]
      %+  skid  ~(tap by peers:v-ames)
      |=  [^ship kind=?(%alien %known)]
      ?=(%known kind)
    %-  some
    %-  pairs
    ::NOTE  would do (cork head ship) but can't get that to compile...
    :~  'known'^a+(turn (turn known head) ship)
        'alien'^a+(turn (turn alien head) ship)
    ==
  ::
    ::  /ames/peer/[shipname].json
    ::
      [%ames %peer @ ~]
    =/  who=^ship
      (rash i.t.t.site fed:ag)
    %-  some
    =,  v-ames
    (peer-to-json (peer who))
  ::
    ::  /behn/timers.json
    ::
      [%behn %timers ~]
    %-  some
    :-  %a
    %+  turn  timers:v-behn
    |=  [date=@da =duct]
    %-  pairs
    :~  'date'^(time date)
        'duct'^a+(turn duct path)
    ==
  ::
    ::  /clay/commits.json
    ::
      [%clay %commits ~]
    (some commits-json:v-clay)
  ::
    ::  /eyre/bindings.json
    ::
      [%eyre %bindings ~]
    %-  some
    :-  %a
    %+  turn  bindings:v-eyre
    =,  eyre
    |=  [binding =duct =action]
    %-  pairs
    :~  'location'^s+(cat 3 (fall site '*') (spat path))
        'action'^(render-action:v-eyre action)
    ==
  ::
    ::  /eyre/connections.json
    ::
      [%eyre %connections ~]
    %-  some
    :-  %a
    %+  turn  ~(tap by connections:v-eyre)
    |=  [=duct outstanding-connection:eyre]
    %-  pairs
    :~  'duct'^a+(turn duct path)
        'action'^(render-action:v-eyre action)
      ::
        :-  'request'
        %-  pairs
        =,  inbound-request
        :~  'authenticated'^b+authenticated
            'secure'^b+secure
            'source'^s+(scot %if +.address)
            :: ?-  -.address
            ::   %ipv4  %if
            ::   %ipv6  %is
            :: ==
        ==
      ::
        :-  'response'
        %-  pairs
        :~  'sent'^(numb bytes-sent)
          ::
            :-  'header'
            ?~  response-header  ~
            =,  u.response-header
            %-  pairs
            :~  'status-code'^(numb status-code)
              ::
                :-  'headers'
                :-  %a
                %+  turn  headers
                |=([k=@t v=@t] s+:((cury cat 3) k ': ' v))
            ==
        ==
    ==
  ::
    ::  /eyre/authentication.json
    ::
      [%eyre %authentication ~]
    %-  some
    :-  %a
    %+  turn
      %+  sort  ~(tap by sessions:auth-state:v-eyre)
      |=  [[@uv a=session:eyre] [@uv b=session:eyre]]
      (gth expiry-time.a expiry-time.b)
    |=  [cookie=@uv session:eyre]
    %-  pairs
    :~  'cookie'^s+(end 3 4 (rsh 3 2 (scot %x (shax cookie))))
        'expiry'^(time expiry-time)
        'channels'^(numb ~(wyt in channels))
    ==
  ::
    ::  /eyre/channels.json
    ::
      [%eyre %channels ~]
    %-  some
    :-  %a
    =+  channel-state:v-eyre
    %+  turn  ~(tap by session)
    |=  [key=@t channel:eyre]
    %-  pairs
    :~  'session'^s+key
        'connected'^b+!-.state
        'expiry'^?-(-.state %& (time date.p.state), %| ~)
        'next-id'^(numb next-id)
        'unacked'^a+(turn (sort (turn ~(tap in events) head) dor) numb)
      ::
        :-  'subscriptions'
        :-  %a
        %+  turn  ~(tap by subscriptions)
        |=  [=wire [=^ship app=term =^path *]]
        %-  pairs
        :~  'wire'^(^path wire)
            'ship'^(^ship ship)
            'app'^s+app
            'path'^(^path path)
        ==
    ==
  ==
::
++  get-file-at
  |=  [base=path file=path ext=@ta]
  ^-  (unit octs)
  ?.  ?=(?(%html %css %js %png) ext)
    ~
  =/  =path
    :*  (scot %p our.bowl)
        q.byk.bowl
        (scot %da now.bowl)
        (snoc (weld base file) ext)
    ==
  ?.  .^(? %cu path)  ~
  %-  some
  %-  as-octs:mimes:html
  .^(@ %cx path)
::
::  applications
::
++  apps
  |%
  ++  all
    ^-  (list term)
    %+  murn
      (scry (list path) %ct %home /app)
    |=  =path
    ^-  (unit term)
    ?.  ?=([%app @ %hoon ~] path)  ~
    `i.t.path
  ::
  ++  running
    |=  app=term
    (scry ? %gu app ~)
  ::
  ++  dbugable
    |=  app=term
    ^-  ?
    !!  ::TODO  how to check if it supports the /dbug scries?
  ::
  ++  state
    |=  app=term
    ^-  vase
    (scry-dbug vase app /state)
  ::
  ++  state-at
    |=  [app=term what=(unit @t)]
    ^-  tank
    =/  state=vase  (state app)
    ?~  what  (sell state)
    =/  result=(each vase tang)
      %-  mule  |.
      %+  slap
        (slop state !>([bowl=bowl ..zuse]))
      (ream u.what)
    ?-  -.result
      %&  (sell p.result)
      %|  (head p.result)
    ==
  ::
  ++  subscriptions
    =,  gall
    |=  app=term
    ^-  [out=boat in=bitt]
    (scry-dbug ,[boat bitt] app /subscriptions)
  ::
  ++  scry-dbug
    |*  [=mold app=term =path]
    (scry mold %gx app (snoc `^path`[%dbug path] %noun))
  ::
  ::TODO  but why? we can't tell if it's on or not
  ++  poke-verb-toggle
    |=  app=term
    ^-  card
    (poke /verb/[app] app %verb !>(%loud))
  --
::
::  threads
::
++  threads
  |%
  ::NOTE  every (list tid:spider) represents a stack,
  ::      with a unique tid at the end
  ++  tree
    (scry (list (list tid:spider)) %gx %spider /tree/noun)
  ::
  ++  poke-kill
    |=  =tid:spider
    ^-  card
    (poke /spider/kill/[tid] %spider %spider-stop !>([tid |]))
  --
::
::  ames
::
++  v-ames
  |%
  ++  peers
    (scry (map ship ?(%alien %known)) %ax %$ /peers)
  ::
  ++  peer
    |=  who=ship
    (scry ship-state:ames %ax %$ /peers/(scot %p who))
  ::
  ++  peer-to-json
    =,  ames
    =,  enjs:format
    |=  =ship-state
    |^  ^-  json
        %+  frond  -.ship-state
        ?-  -.ship-state
          %alien  (alien +.ship-state)
          %known  (known +.ship-state)
        ==
    ::
    ++  alien
      |=  alien-agenda
      %-  pairs
      :~  'messages'^(numb (lent messages))
          'packets'^(numb ~(wyt in packets))
          'heeds'^(set-array heeds from-duct)
      ==
    ::
    ::  json for known peer is structured to closely match the peer-state type.
    ::  where an index is specified, the array is generally sorted by those.
    ::
    ::  { life: 123,
    ::    route: { direct: true, lane: 'something' },
    ::    qos: { kind: 'status', last-contact: 123456 },  // ms timestamp
    ::    flows: { forward: [snd, rcv, ...], backward: [snd, rcv, ...] }
    ::    ->  snd:
    ::        { bone: 123,  // index
    ::          duct: ['/paths', ...]
    ::          current: 123,
    ::          next: 123,
    ::          unsent-messages: [123, ...],  // size in bytes
    ::          queued-message-acks: [{
    ::            message-num: 123,  // index
    ::            ack: 'ok'
    ::          }, ...],
    ::          packet-pump-state: {
    ::            next-wake: 123456,  // ms timestamp
    ::            live: [{
    ::              message-num: 123,  // index
    ::              fragment-num: 123,  // index
    ::              num-fragments: 123,
    ::              last-sent: 123456,  //  ms timestamp
    ::              retries: 123,
    ::              skips: 123
    ::            }, ...],
    ::            metrics: {
    ::              rto: 123,  // seconds
    ::              rtt: 123,  // seconds
    ::              rttvar: 123,
    ::              ssthresh: 123,
    ::              num-live: 123,
    ::              cwnd: 123,
    ::              counter: 123
    ::            }
    ::          }
    ::        }
    ::    ->  rcv:
    ::        { bone: 123,  // index
    ::          duct: ['/paths', ...]  // index
    ::          last-acked: 123,
    ::          last-heard: 123,
    ::          pending-vane-ack: [123, ...],
    ::          live-messages: [{
    ::            message-num: 123,  // index
    ::            num-received: 122,
    ::            num-fragments: 123,
    ::            fragments: [123, ...]
    ::          }, ...],
    ::          nax: [123, ...]
    ::        }
    ::    nax: [{
    ::      bone: 123,  // index
    ::      duct: ['/paths', ...],
    ::      message-num: 123
    ::    }, ...],
    ::    heeds: [['/paths', ...] ...]
    ::  }
    ::
    ++  known
      |=  peer-state
      %-  pairs
      :~  'life'^(numb life)
        ::
          :-  'route'
          %+  maybe  route
          |=  [direct=? =lane]
          %-  pairs
          :~  'direct'^b+direct
            ::
              :-  'lane'
              ?-  -.lane
                %&  (ship p.lane)
              ::
                  %|
                ?~  l=((soft ,[=@tas =@if =@ud]) (cue p.lane))
                  s+(scot %x p.lane)
                =,  u.l
                (tape "%{(trip tas)}, {(scow %if if)}, {(scow %ud ud)}")
              ==
          ==
        ::
          :-  'qos'
          %-  pairs
          :~  'kind'^s+-.qos
              'last-contact'^(time last-contact.qos)
          ==
        ::
          :-  'flows'
          |^  =/  mix=(list flow)
                =-  (sort - dor)
                %+  welp
                  (turn ~(tap by snd) (tack %snd))
                (turn ~(tap by rcv) (tack %rcv))
              =/  [forward=(list flow) backward=(list flow)]
                %+  skid  mix
                |=  [=bone *]
                =(0 (mod bone 2))
              %-  pairs
              :~  ['forward' a+(turn forward build)]
                  ['backward' a+(turn backward build)]
              ==
          ::
          +$  flow
            $:  =bone
              ::
                $=  state
                $%  [%snd message-pump-state]
                    [%rcv message-sink-state]
                ==
            ==
          ::
          ++  tack
            |*  =term
            |*  [=bone =noun]
            [bone [term noun]]
          ::
          ++  build
            |=  flow
            ^-  json
            %+  frond  -.state
            ?-  -.state
              %snd  (snd-with-bone ossuary bone +.state)
              %rcv  (rcv-with-bone ossuary bone +.state)
            ==
          --
        ::
          :-  'nax'
          :-  %a
          %+  turn  (sort ~(tap in nax) dor)  ::  sort by bone
          |=  [=bone =message-num]
          %-  pairs
          :*  'message-num'^(numb message-num)
              (bone-to-pairs bone ossuary)
          ==
        ::
          'heeds'^(set-array heeds from-duct)
      ==
    ::
    ++  snd-with-bone
      |=  [=ossuary =bone message-pump-state]
      ^-  json
      %-  pairs
      :*  'current'^(numb current)
          'next'^(numb next)
        ::
          :-  'unsent-messages'  ::  as byte sizes
          (set-array unsent-messages (cork (cury met 3) numb))
        ::
          'unsent-fragments'^(numb (lent unsent-fragments))  ::  as lent
        ::
          :-  'queued-message-acks'
          :-  %a
          %+  turn  (sort ~(tap by queued-message-acks) dor)  ::  sort by msg nr
          |=  [=message-num =ack]
          %-  pairs
          :~  'message-num'^(numb message-num)
              'ack'^s+-.ack
          ==
        ::
          :-  'packet-pump-state'
          %-  pairs
          =,  packet-pump-state
          :~  'next-wake'^(maybe next-wake time)
            ::
              :-  'live'
              :-  %a
              %+  turn  (sort ~(tap in live) dor)  ::  sort by msg nr & frg nr
              |=  [live-packet-key live-packet-val]
              %-  pairs
              :~  'message-num'^(numb message-num)
                  'fragment-num'^(numb fragment-num)
                  'num-fragments'^(numb num-fragments)
                  'last-sent'^(time last-sent)
                  'retries'^(numb retries)
                  'skips'^(numb skips)
              ==
            ::
              :-  'metrics'
              %-  pairs
              =,  metrics
              :~  'rto'^(numb (div rto ~s1))  ::TODO  milliseconds?
                  'rtt'^(numb (div rtt ~s1))
                  'rttvar'^(numb (div rttvar ~s1))
                  'ssthresh'^(numb ssthresh)
                  'num-live'^(numb num-live)
                  'cwnd'^(numb cwnd)
                  'counter'^(numb counter)
              ==
          ==
        ::
          (bone-to-pairs bone ossuary)
      ==
    ::
    ++  rcv-with-bone
      |=  [=ossuary =bone message-sink-state]
      ^-  json
      %-  pairs
      :*  'last-acked'^(numb last-acked)
          'last-heard'^(numb last-heard)
        ::
          :-  'pending-vane-ack'
          =-  a+(turn - numb)
          (sort (turn ~(tap in pending-vane-ack) head) dor)  ::  sort by msg #
        ::
          :-  'live-messages'
          :-  %a
          %+  turn  (sort ~(tap by live-messages) dor)  ::  sort by msg #
          |=  [=message-num partial-rcv-message]
          %-  pairs
          :~  'message-num'^(numb message-num)
              'num-received'^(numb num-received)
              'num-fragments'^(numb num-fragments)
              'fragments'^(set-array ~(key by fragments) numb)
          ==
        ::
          'nax'^a+(turn (sort ~(tap in nax) dor) numb)
        ::
          (bone-to-pairs bone ossuary)
      ==
    ::
    ++  bone-to-pairs
      |=  [=bone ossuary]
      ^-  (list [@t json])
      :~  'bone'^(numb bone)
          'duct'^(from-duct (~(gut by by-bone) bone ~))
      ==
    ::
    ++  maybe
      |*  [unit=(unit) enjs=$-(* json)]
      ^-  json
      ?~  unit  ~
      (enjs u.unit)
    ::
    ++  set-array
      |*  [set=(set) enjs=$-(* json)]
      ^-  json
      a+(turn ~(tap in set) enjs)
    ::
    ++  from-duct
      |=  =duct
      a+(turn duct path)
    --
  --
::
::  behn
::
++  v-behn
  |%
  ++  timers
    (scry ,(list [date=@da =duct]) %bx %$ /debug/timers)
  --
::
::  clay
::
::TODO  depends on new clay changes (%s care)
++  v-clay
  =,  clay
  |%
  ++  start-path  /(scot %p our.bowl)/home/(scot %da now.bowl)
  ::
  +$  commit
    [=tako parents=(list tako) children=(list tako) wen=@da content-hash=@uvI]
  ::
  ++  commits-json
    ^-  json
    =+  .^(desks=(set desk) %cd start-path)
    =/  heads=(list [tako desk])
      %+  turn  ~(tap in desks)
      |=  =desk
      =+  .^(=dome %cv /(scot %p our.bowl)/[desk]/(scot %da now.bowl))
      =/  =tako  (~(got by hit.dome) let.dome)
      [tako desk]
    =/  yakis=(set yaki)
      %-  silt
      ^-  (list yaki)
      %-  zing
      %+  turn  heads
      |=  [=tako =desk]
      (trace-tako tako)
    =/  commits=(list commit)  (yakis-to-commits ~(tap in yakis))
    =,  enjs:format
    %:  pairs
      head+(pairs (turn heads |=([=tako =desk] (scot %uv tako)^s+desk)))
      commits+(commits-to-json commits)
      ~
    ==
  ::
  ++  yakis-to-commits
    |=  yakis=(list yaki)
    ^-  (list commit)
    %+  turn  yakis
    |=  =yaki
    :*  r.yaki  p.yaki
        =/  candidates
          %+  turn
            (skim yakis |=(can=^yaki (lien p.can |=(=tako =(r.yaki tako)))))
          |=  can=^yaki
          r.can
        ~(tap in (silt candidates))
        t.yaki
        .^(@uvI %cs (weld start-path /hash/(scot %uv r.yaki)))
    ==
  ::
  ++  trace-tako
    |=  =tako
    ~+
    ^-  (list yaki)
    =+  .^(=yaki %cs (weld start-path /yaki/(scot %uv tako)))
    :-  yaki
    (zing (turn p.yaki trace-tako))
  ::
  ++  commits-to-json
    |=  commits=(list commit)
    ^-  json
    :-  %a
    %+  turn
      %+  sort  commits
      |=  [a=commit b=commit]
      (gte wen.a wen.b)
    |=  =commit
    (commit-to-json commit)
  ::
  ++  commit-to-json
    |=  =commit
    ^-  json
    =,  enjs:format
    %:  pairs
      'commitHash'^(tako-to-json tako.commit)
      parents+a+(turn parents.commit tako-to-json)
      children+a+(turn children.commit tako-to-json)
      'contentHash'^(tako-to-json content-hash.commit)
      ~
    ==
  ::
  ++  tako-to-json
    |=  =tako
    ^-  json
    s+(scot %uv tako)
  --
::
::  eyre
::
++  v-eyre
  =,  eyre
  |%
  ++  bindings
    (scry ,(list [=binding =duct =action]) %e %bindings ~)
  ::
  ++  connections
    (scry ,(map duct outstanding-connection) %e %connections ~)
  ::
  ++  auth-state
    (scry authentication-state %e %authentication-state ~)
  ::
  ++  channel-state
    (scry ^channel-state %e %channel-state ~)
  ::
  ++  render-action
    |=  =action
    ^-  json
    :-  %s
    ?+  -.action  -.action
      %gen  :((cury cat 3) '+' (spat [desk path]:generator.action))
      %app  (cat 3 ':' app.action)
    ==
  --
::
::  helpers
::
++  poke
  |=  [=wire app=term =mark =vase]
  ^-  card
  [%pass wire %agent [our.bowl app] %poke mark vase]
::
++  scry
  |*  [=mold care=term =desk =path]
  .^(mold care (scot %p our.bowl) desk (scot %da now.bowl) path)
--