adds new :dns apps (client and "collector"), moves old to :dns-bind

app/dns-collector.hoon

@@ -0,0 +1,106 @@
+/-  dns
+/+  tapp, stdio
+::
+::  tapp types and boilerplate
+::
+=>  |%
+    +$  app-state
+      $:  %0
+          requested=(map ship address:dns)
+          completed=(map ship binding:dns)
+      ==
+    +$  peek-data  [%noun (list (pair ship address:dns))]
+    +$  in-poke-data
+      $%  [%dns-address =address:dns]
+          [%dns-complete =ship =binding:dns]
+      ==
+    +$  out-poke-data  ~
+    +$  in-peer-data   ~
+    +$  out-peer-data
+      $%  [%dns-binding =binding:dns]
+      ==
+    ++  tapp   (^tapp app-state peek-data in-poke-data out-poke-data in-peer-data out-peer-data)
+    ++  stdio  (^stdio out-poke-data out-peer-data)
+    --
+::
+=*  tapp-async    tapp-async:tapp
+=*  default-tapp  default-tapp:tapp
+%-  create-tapp-all:tapp
+^-  tapp-core-all:tapp
+|_  [=bowl:gall state=app-state]
+::
+++  handle-init  handle-init:default-tapp
+++  handle-diff  handle-diff:default-tapp
+++  handle-take  handle-take:default-tapp
+::
+++  handle-poke
+  |=  =in-poke-data
+  =/  m  tapp-async
+  ^-  form:m
+  ?-  -.in-poke-data
+      %dns-address
+    =*  who  src.bowl
+    =*  adr  address.in-poke-data
+    =/  rac  (clan:title who)
+    ?.  ?=(?(%king %duke) rac)
+      ~|  [%dns-collector-bind-invalid rac]  !!
+    ?:  (reserved:eyre if.adr)
+      ~|  [%reserved-address if.adr]  !!
+    ::
+    =/  req=(unit address:dns)  (~(get by requested.state) who)
+    =/  dun=(unit binding:dns)  (~(get by completed.state) who)
+    ?:  &(?=(^ dun) =(adr address.u.dun))
+      ;<  ~  bind:m  (give-result:stdio /(scot %p who) %dns-binding u.dun)
+      =.  requested.state  (~(del by requested.state) who)
+      (pure:m state)
+    ?:  &(?=(^ req) =(adr u.req))
+      (pure:m state)
+    ::  XX check address?
+    =.  requested.state  (~(put by requested.state) who adr)
+    (pure:m state)
+  ::
+      %dns-complete
+    ?.  (team:title [our src]:bowl)
+      ~|  %complete-yoself  !!
+    =*  who  ship.in-poke-data
+    =*  adr  address.binding.in-poke-data
+    =*  tuf  turf.binding.in-poke-data
+    =/  req=(unit address:dns)  (~(get by requested.state) who)
+    ::  ignore established bindings that don't match requested
+    ::
+    ?:  ?&  ?=(^ req)
+            !=(adr u.req)
+        ==
+      (pure:m state)
+    =:  requested.state  (~(del by requested.state) who)
+        completed.state  (~(put by completed.state) who [adr tuf])
+      ==
+    ;<  ~  bind:m  (give-result:stdio /(scot %p who) %dns-binding adr tuf)
+    (pure:m state)
+  ==
+::
+++  handle-peek
+  |=  =path
+  ^-  (unit (unit peek-data))
+  ~&  path
+  ?+  path  [~ ~]
+      [%x %requested ~]
+    [~ ~ %noun ~(tap by requested.state)]
+  ==
+::
+++  handle-peer
+  |=  =path
+  =/  m  tapp-async
+  ^-  form:m
+  ?:  ?=([%sole *] path)
+    ~|  %default-tapp-no-sole  !!
+  ?.  ?=([@ ~] path)
+    ~|  %invalid-path  !!
+  =/  who  (slaw %p i.path)
+  ?~  who
+    ~|  %invalid-path  !!
+  ?~  dun=(~(get by completed.state) who)
+    (pure:m state)
+  ;<  ~  bind:m  (give-result:stdio path %dns-binding u.dun)
+  (pure:m state)
+--

gen/dns/auto.hoon

@@ -0,0 +1,7 @@
+::  DNS: configure automatically
+::
+::::  /hoon/auto/dns/gen
+  ::
+:-  %say
+|=  [[now=@da eny=@uvJ bec=beak] ~ ~]
+[%dns-auto ~]

gen/dns/ip.hoon

@@ -9,7 +9,7 @@
         [arg=$@(~ [addr=@if ~])]
         ~
     ==
-^-  (sole-result [%dns-command command])
+^-  (sole-result [%dns-address address])
 =*  our  p.bec
 =-  ?~  arg  -
     (fun.q.q addr.arg)
@@ -22,4 +22,4 @@
   =/  msg  "unable to bind reserved ipv4 address {(scow %if addr)}"
   (print leaf+msg no-product)
 %-  produce
-[%dns-command %ip %if addr]
+[%dns-address %if addr]

lib/stdio.hoon

@@ -320,4 +320,14 @@
     (pure:m ~)
   ;<  ~  bind:m  (send-effect-on-bone i.bones %diff out-peer-data)
   loop(bones t.bones)
+::
+::    ----
+::
+::  Handle domains
+::
+++  install-domain
+  |=  =turf
+  =/  m  (async ,~)
+  ^-  form:m
+  (send-effect %rule / %turf %put turf)
 --

mar/dns/address.hoon

@@ -0,0 +1,7 @@
+/-  *dns
+|_  address
+++  grab
+  |%
+  ++  noun  address
+  --
+--

mar/dns/binding.hoon

@@ -0,0 +1,7 @@
+/-  *dns
+|_  binding
+++  grab
+  |%
+  ++  noun  binding
+  --
+--

mar/dns/complete.hoon

@@ -0,0 +1,7 @@
+/-  *dns
+|_  [ship binding]
+++  grab
+  |%
+  +$  noun  [ship binding]
+  --
+--

sur/dns-bind.hoon

@@ -0,0 +1,71 @@
+|%
+::  +provider: DNS service provider (gcloud only for now)
+::
++$  provider
+  $%  [%fcloud zone=@ta auth=[email=@t key=@t]]
+      [%gcloud project=@ta zone=@ta auth=(unit [access=@t refresh=@t])]
+  ==
+::  +authority: responsibility for a DNS zone
+::
++$  authority
+  $:  :: dom: authority over a fully-qualified domain
+      ::
+      dom=turf
+      :: pro: DNS service provider
+      ::
+      pro=provider
+  ==
+::  +target: a ship is bound to a ...
+::
++$  target
+  $%  :: %direct: an A record
+      ::
+      [%direct %if p=@if]
+      :: %indirect: a CNAME record
+      ::
+      [%indirect p=ship]
+  ==
+::  +bound: an established binding, plus history
+::
++$  bound
+  $:  :: wen: established
+      ::
+      wen=@da
+      ::  id:  binding UUID (unused by gcloud)
+      ::
+      id=@ta
+      :: cur: current target
+      ::
+      cur=target
+      :: hit: historical targets
+      ::
+      hit=(list (pair @da target))
+  ==
+::  +nameserver: a b s o l u t e  p o w e r
+::
++$  nameserver
+  $:  aut=authority
+      bon=(map ship bound)
+      dep=(jar ship (pair ship target))
+      pen=(map ship target)
+  ==
+::  +relay: a good parent keeps track
+::
++$  relay
+  $:  wen=@da
+      wer=(unit @if)
+      ::  XX track bound state per domain
+      ::
+      dom=(unit turf)
+      tar=target
+  ==
+::  +command: top-level app actions
+::
++$  command
+  $%  [%authority aut=authority]
+      [%bind for=ship him=ship tar=target]
+      [%bond for=ship him=ship dom=turf]
+      [%ip %if addr=@if]
+      [%meet him=ship]
+  ==
+--

sur/dns.hoon

@@ -1,71 +1,4 @@
 |%
-::  +provider: DNS service provider (gcloud only for now)
++$  address  [%if if=@if]
-::
++$  binding  [=address =turf]
-+$  provider
-  $%  [%fcloud zone=@ta auth=[email=@t key=@t]]
-      [%gcloud project=@ta zone=@ta auth=(unit [access=@t refresh=@t])]
-  ==
-::  +authority: responsibility for a DNS zone
-::
-+$  authority
-  $:  :: dom: authority over a fully-qualified domain
-      ::
-      dom=turf
-      :: pro: DNS service provider
-      ::
-      pro=provider
-  ==
-::  +target: a ship is bound to a ...
-::
-+$  target
-  $%  :: %direct: an A record
-      ::
-      [%direct %if p=@if]
-      :: %indirect: a CNAME record
-      ::
-      [%indirect p=ship]
-  ==
-::  +bound: an established binding, plus history
-::
-+$  bound
-  $:  :: wen: established
-      ::
-      wen=@da
-      ::  id:  binding UUID (unused by gcloud)
-      ::
-      id=@ta
-      :: cur: current target
-      ::
-      cur=target
-      :: hit: historical targets
-      ::
-      hit=(list (pair @da target))
-  ==
-::  +nameserver: a b s o l u t e  p o w e r
-::
-+$  nameserver
-  $:  aut=authority
-      bon=(map ship bound)
-      dep=(jar ship (pair ship target))
-      pen=(map ship target)
-  ==
-::  +relay: a good parent keeps track
-::
-+$  relay
-  $:  wen=@da
-      wer=(unit @if)
-      ::  XX track bound state per domain
-      ::
-      dom=(unit turf)
-      tar=target
-  ==
-::  +command: top-level app actions
-::
-+$  command
-  $%  [%authority aut=authority]
-      [%bind for=ship him=ship tar=target]
-      [%bond for=ship him=ship dom=turf]
-      [%ip %if addr=@if]
-      [%meet him=ship]
-  ==
 --

sur/tapp.hoon

@@ -12,6 +12,7 @@
       [%diff out-peer-data]
       [%request wire request:http outbound-config:http-client]
       [%cancel-request wire ~]
+      [%rule wire %turf %put turf]
   ==
 ::
 ::  Possible async responses

tests/app/dns.hoon

@@ -1,20 +0,0 @@
-/+  *test
-::
-/=  app  /:  /===/app/dns
-             /!noun/
-::
-|%
-::  tests that :dns preps without moves
-::
-++  test-prep
-  ::  .our explicitly set to not-a-galaxy to avoid failing %jael scry
-  ::  (can't control the scry product without virtualizing)
-  ::
-  =/  bow=bowl:gall  =>(*bowl:gall .(our ~marzod))
-  =^  moves  app  (~(prep app bow *state:app) ~)
-  %+  expect-eq
-      !>  ^-  (list move:app)
-          :~  [ost.bow %connect /dns/oauth [~ /dns/oauth] %dns]
-          ==
-      !>  moves
---