From 42a285efef9d1afd7941166c46e1151d4005530e Mon Sep 17 00:00:00 2001
From: Joe Bryan <joemfb@gmail.com>
Date: Tue, 30 Oct 2018 15:05:42 -0400
Subject: [PATCH] simplifies :dns, removing dependence on %ames routing

---
 app/dns.hoon           | 281 ++++++++++++++++++++++-------------------
 gen/dns/authority.hoon |  14 +-
 gen/dns/ip.hoon        |  22 ++++
 mar/dns/bind.hoon      |  11 --
 mar/dns/bond.hoon      |  11 --
 mar/dns/command.hoon   |  10 ++
 sur/dns.hoon           |   9 ++
 sys/vane/ames.hoon     |  15 ++-
 8 files changed, 211 insertions(+), 162 deletions(-)
 create mode 100644 gen/dns/ip.hoon
 delete mode 100644 mar/dns/bind.hoon
 delete mode 100644 mar/dns/bond.hoon
 create mode 100644 mar/dns/command.hoon

diff --git a/app/dns.hoon b/app/dns.hoon
index da5f560be..48c5bcf0c 100644
--- a/app/dns.hoon
+++ b/app/dns.hoon
@@ -6,19 +6,16 @@
 =>  |%
 +$  move  (pair bone card)
 +$  poke
-  $%  [%dns-bind for=ship him=ship target]
-      [%dns-bond for=ship him=ship turf]
-      [%dns-authority authority]
+  $%  [%dns-command command]
       ::  XX find some other notification channel?
       ::
       [%helm-send-hi ship (unit tape)]
   ==
 +$  card
-  $%  [%tend wire ~]
-      [%wait wire @da]
+  $%  [%hiss wire [~ ~] %httr %hiss hiss:eyre]
       [%poke wire dock poke]
       [%rule wire %turf %put turf]
-      [%hiss wire [~ ~] %httr %hiss hiss:eyre]
+      [%wait wire @da]
   ==
 ::  +state: complete app state
 ::
@@ -181,44 +178,64 @@
 ++  sigh-httr
   |=  [wir=wire rep=httr:eyre]
   ^-  (quip move _this)
-  ?-  wir
-      [%authority %confirm ~]
-    ?~  nem
-      ~&  [%strange-authority wire=wir response=rep]
-      [~ this]
-    ?.  =(200 p.rep)
-      ~&  [%authority-confirm-fail rep]
-      [~ this(nem ~)]
-    :: XX anything to do here? parse body?
+  ::  at least two segments in every wire
+  ::
+  ?.  ?=([@ @ *] wir)
+    ~&  [%strange-http-response wire=wir response=rep]
     [~ this]
-  ::
-      [%authority %create @ %for @ ~]
-    ?~  nem
-      ~&  [%strange-authority wire=wir response=rep]
-      [~ this]
-    ?.  =(200 p.rep)
-      ~&  [%authority-create-fail wire=wir response=rep]
-      [~ this]
-    =/  him=ship  (slav %p i.t.t.wir)
-    =/  for=ship  (slav %p i.t.t.t.t.wir)
-    abet:(~(confirm bind u.nem) for him)
-  ::
-      [%check @ ~]
-    =/  him=ship  (slav %p i.t.wir)
-    ?:  =(200 p.rep)
-      abet:~(bind tell [him (~(get by per) him)])
-    :: cttp timeout
-    ?:  =(504 p.rep)
-      :: XX backoff, refactor
-      :_  this  :_  ~
-      [ost.bow %wait wir (add now.bow ~m10)]
-    :: XX specific messages per status code
-    ~&  %direct-confirm-fail
-    abet:(~(fail tell [him (~(get by per) him)]) %failed-request)
-  ::
-      *
+  ?+  i.wir
+    ::  print and ignore unrecognized responses
+    ::
     ~&  +<
     [~ this]
+  ::  responses for a nameserver
+  ::
+      %authority
+    ?~  nem
+      ~&  [%strange-authority wire=wir response=rep]
+      [~ this]
+    ?+  i.t.wir
+      !!
+    ::  response confirming a valid nameserver config
+    ::  XX attempt to download existing ship.domain bindings for a breach?
+    :: 
+        %confirm
+      ?.  =(200 p.rep)
+        ~&  [%authority-confirm-fail rep]
+        [~ this(nem ~)]
+      ::  XX anything to do here? parse body?
+      ::
+      [~ this]
+    ::  response to a binding creation request
+    ::
+        %create
+      ?>  ?=([@ %for @ ~] t.t.wir)
+      ?.  =(200 p.rep)
+        ::  XX set a retry timeout?
+        ::
+        ~&  [%authority-create-fail wire=wir response=rep]
+        [~ this]
+      =/  him=ship  (slav %p i.t.t.wir)
+      =/  for=ship  (slav %p i.t.t.t.t.wir)
+      abet:(~(confirm bind u.nem) for him)
+    ==
+  ::  responses for a relay validating a binding
+  ::
+      %check
+    =/  him=ship  (slav %p i.t.wir)
+    ?:  =(200 p.rep)
+      abet:bind:(tell him)
+    ::  cttp timeout
+    ::
+    ?:  =(504 p.rep)
+      ::  XX backoff, refactor
+      ::
+      :_  this  :_  ~
+      [ost.bow %wait wir (add now.bow ~m10)]
+    ::  XX specific messages per status code
+    ::
+    ~&  %direct-confirm-fail
+    abet:(fail:(tell him) %failed-request)
   ==
 ::  +sigh-tang: failed to make http request
 ::
@@ -237,7 +254,7 @@
     ~&  %direct-confirm-fail
     =/  him=ship  (slav %p i.t.wir)
     %-  (slog saw)
-    abet:(~(fail tell [him (~(get by per) him)]) %crash)
+    abet:(fail:(tell him) %crash)
   ==
 ::  +wake: timer callback
 ::
@@ -248,55 +265,82 @@
     ~&  [%strange-wake wir]
     [~ this]
   =/  him=ship  (slav %p i.t.wir)
-  abet:~(check tell [him (~(get by per) him)])
-::  +poke-dns-authority: configure self as an authority
+  abet:check:(tell him)
+::  +poke-dns-command: act on command
 ::
-++  poke-dns-authority
-  |=  aut=authority
+++  poke-dns-command
+  |=  com=command
   ^-  (quip move _this)
-  ~|  %authority-reset-wat-do
-  ?<  ?=(^ nem)
-  abet:(init:bind aut)
-::  +poke-dns-bind: create binding (if authority), forward request
-::
-++  poke-dns-bind
-  |=  [for=ship him=ship tar=target]
-  ^-  (quip move _this)
-  ~&  [%bind src=src.bow +<.$]
-  =/  lan  (clan:title him)
-  ?:  ?=(%czar lan)
-    ~|(%bind-galazy !!)
-  ?:  =(for him)
-    ~|(%bind-yoself !!)
-  ?:  ?&  ?=(%king lan)
-          ?=(%indirect -.tar)
-      ==
-    ~|(%bind-indirect-star !!)
-  :: always forward, there may be multiple authorities
+  ?-  -.com
+  ::  configure self as an authority
   ::
-  =^  zom=(list move)  ..this
-    abet:(~(forward tell [him (~(get by per) him)]) for tar)
-  =^  zam=(list move)  ..this
-    ?~  nem  [~ this]
-    abet:(~(create bind u.nem) for him tar)
-  [(weld zom zam) this]
-::  +poke-dns-bond: process established dns binding
-::
-++  poke-dns-bond
-  |=  [for=ship him=ship dom=turf]
-  ^-  (quip move _this)
-  ?:  =(for him)
-    ~|(%bond-yoself !!)
-  ?:  =(our.bow him)
-    ~&  [%bound-us dom]
-    :-  [[ost.bow %rule /bound %turf %put dom] ~]
-    this(dom (~(put in ^dom) dom))
-  ?:  =(our.bow for)
-    ~&  [%bound-him him dom]
-    =<  abet
-    (~(bake tell [him (~(get by per) him)]) dom)
-  ~&  [%strange-bond +<]
-  [~ this]
+  ::    [%authority authority]
+  ::
+      %authority
+    ~|  %authority-reset-wat-do
+    ?<  ?=(^ nem)
+    ~!  com
+    abet:(init:bind aut.com)
+  ::  create binding (if authority) and forward request
+  ::
+  ::    [%bind for=ship him=ship target]
+  ::
+      %bind
+    ~&  [%bind src=src.bow +<.$]
+    =/  rac  (clan:title him.com)
+    ?:  ?=(%czar rac)
+      ~|(%bind-galazy !!)
+    ?:  ?&  =(for.com him.com)
+            !?=(%king rac)
+        ==
+      ~|(%bind-yoself !!)
+    ?:  ?&  ?=(%king rac)
+            ?=(%indirect -.tar.com)
+        ==
+      ~|(%bind-indirect-star !!)
+    ::  always forward, there may be multiple authorities
+    ::
+    =^  zom=(list move)  ..this
+      abet:(forward:(tell him.com) [for tar]:com)
+    =^  zam=(list move)  ..this
+      ?~  nem  [~ this]
+      abet:(~(create bind u.nem) [for him tar]:com)
+    [(weld zom zam) this]
+  ::  process established dns binding
+  ::
+  ::    [%bond for=ship him=ship turf]
+  ::
+      %bond
+    ?:  =(for.com him.com)
+      ~|(%bond-yoself !!)
+    ?:  =(our.bow him.com)
+      ~&  [%bound-us dom.com]
+      :-  [[ost.bow %rule /bound %turf %put dom.com] ~]
+      this(dom (~(put in dom) dom.com))
+    ?:  =(our.bow for.com)
+      ~&  [%bound-him him.com dom.com]
+      abet:(bake:(tell him.com) dom.com)
+    ~&  [%strange-bond com]
+    [~ this]
+  ::  manually set our ip, request direct binding
+  ::
+  ::    [%ip %if addr=@if]
+  ::
+      %ip
+    ?.  =(our.bow src.bow)
+      ~&  %dns-ip-no-foreign
+      [~ this]
+    abet:(hear:(tell our.bow) `addr.com)
+  ::  meet sponsee, request indirect binding
+  ::
+  ::    [%meet him=ship]
+  ::
+      %meet
+    ?.  =(our.bow (sein:title our.bow now.bow him.com))
+      ~&  %dns-meet-not-sponsored
+      [~ this]
+    abet:(hear:(tell him.com) ~)
+  ==
 ::  +coup: general poke acknowledgement or error
 ::
 ++  coup
@@ -304,21 +348,6 @@
   ?~  saw  [~ this]
   ~&  [%coup-fallthru wir]
   [((slog u.saw) ~) this]
-::  +rove: hear %ames +lane change for child ships
-::
-++  rove
-  |=  [wir=wire p=ship q=lane:ames]
-  ^-  (quip move _this)
-  :: XX move to %ames
-  ?:  =(our.bow p)
-    [~ this]
-  ?.  =(our.bow (sein:title our.bow now.bow p))
-    ~&  [%rove-false p]
-    [~ this]
-  ~&  [%rove wir p q]
-  ::  XX assert that we intend to be listening?
-  =<  abet
-  (~(hear tell [p (~(get by per) p)]) q)
 ::  +prep: adapt state
 ::
 ::  ++  prep  _[~ this]
@@ -327,8 +356,8 @@
   ^-  (quip move _this)
   ?^  old
     [~ this(+<+ u.old)]
-  ?:  ?=(?(%czar %king) (clan:title our.bow))
-    abet:listen:tell
+  ::  XX print :dns|ip config instructions for stars?
+  ::
   [~ this]
 ::  |bind: acting as zone authority
 ::
@@ -393,52 +422,42 @@
     =/  dom=turf
       (weld dom.aut.nam /(crip +:(scow %p him)))
     %-  emit
-    [%poke wir [for dap.bow] %dns-bond for him dom]
+    [%poke wir [for dap.bow] %dns-command %bond for him dom]
   --
 ::  |tell: acting as planet parent or relay
 ::
 ++  tell
+  |=  him=ship
   =|  moz=(list move)
-  |_  [him=ship rel=(unit relay)]
+  =/  rel=(unit relay)  (~(get by per) him)
+  |%
   ++  this  .
   ::  +abet: finalize state changes, produce moves
   ::
   ++  abet
     ^-  (quip move _^this)
     :-  (flop moz)
-    ?~  rel
-      ^this
-    ^this(per (~(put by per) him u.rel))
+    =?  per  ?=(^ rel)
+      (~(put by per) him u.rel)
+    ^this
   ::  +emit: emit a move
   ::
   ++  emit
     |=  car=card
     ^+  this
     this(moz [[ost.bow car] moz])
-  ::  +listen: subscribe to %ames +lane changes for child ships
-  ::
-  ++  listen
-    ^+  this
-    (emit [%tend /tend ~])
-  ::  +hear: hear +lane change, maybe emit binding request
+  ::  +hear: hear ip address, maybe emit binding request
   ::
   ++  hear
-    |=  lan=lane:ames
+    |=  addr=(unit @if)
     ^+  this
-    =/  adr=(unit @if)
-      ?.(?=([%if *] lan) ~ `r.lan)
     =/  tar=target
-      ?:  ?|  ?=(~ adr)
-              ?=(%duke (clan:title him))
-          ==
+      ?:  |(?=(~ addr) ?=(%duke (clan:title him)))
         [%indirect our.bow]
-      [%direct %if u.adr]
-    ?.  ?|  ?=(~ rel)
-            !=(tar tar.u.rel)
-            !bon.u.rel
-        ==
+      [%direct %if u.addr]
+    ?.  |(?=(~ rel) !=(tar tar.u.rel) !bon.u.rel)
       this
-    =.  rel  `[wen=now.bow adr bon=| try=0 tar]
+    =.  rel  `[wen=now.bow addr bon=| try=0 tar]
     ?:(?=(%indirect -.tar) bind check)
   ::  +check: confirm %direct target is accessible
   ::
@@ -490,7 +509,7 @@
     =/  wir=wire
       /bind/(scot %p him)/for/(scot %p our.bow)
     %-  emit
-    [%poke wir [our.bow dap.bow] %dns-bind our.bow him tar.u.rel]
+    [%poke wir [our.bow dap.bow] %dns-command %bind our.bow him tar.u.rel]
   ::  +bake: successfully bound
   ::
   ++  bake
@@ -502,7 +521,7 @@
       /forward/bound/(scot %p him)/for/(scot %p our.bow)
     :: XX save domain, track bound-state per-domain
     %-  emit(bon.u.rel &)
-    [%poke wir [him dap.bow] %dns-bond our.bow him dom]
+    [%poke wir [him dap.bow] %dns-command %bond our.bow him dom]
   ::  +forward: sending binding request up the network
   ::
   ++  forward
@@ -520,6 +539,6 @@
     =/  wir=wire
       /forward/bind/(scot %p him)/for/(scot %p for)
     %-  emit  :: XX for
-    [%poke wir [to dap.bow] %dns-bind for him tar]
+    [%poke wir [to dap.bow] %dns-command %bind for him tar]
   --
 --
diff --git a/gen/dns/authority.hoon b/gen/dns/authority.hoon
index e525720bb..c2c3d7cab 100644
--- a/gen/dns/authority.hoon
+++ b/gen/dns/authority.hoon
@@ -2,16 +2,14 @@
 ::
 ::::  /hoon/authority/dns/gen
   ::
-/-  dns, sole
-/+  generators
-=,  dns
-=,  generators
+/-  *dns, *sole
+/+  *generators
 :-  %ask
 |=  $:  [now=@da eny=@uvJ bec=beak]
-        [arg=$@(~ [dom=path ~])]
+        [arg=$@(~ [dom=turf ~])]
         ~
     ==
-^-  (sole-result:sole [%dns-authority authority])
+^-  (sole-result [%dns-command %authority authority])
 =-  ?~  arg  -
     (fun.q.q [%& dom.arg])
 %+  prompt
@@ -28,5 +26,5 @@
   [%& %zone "dns zone: "]
 %+  parse  urs:ab
 |=  zone=@ta
-%+  produce  %dns-authority
-[p.hot %gcloud project zone]
+%-  produce
+[%dns-command %authority [p.hot %gcloud project zone]]
diff --git a/gen/dns/ip.hoon b/gen/dns/ip.hoon
new file mode 100644
index 000000000..3d1e62fa7
--- /dev/null
+++ b/gen/dns/ip.hoon
@@ -0,0 +1,22 @@
+::  DNS: configure ip address
+::
+::::  /hoon/authority/dns/gen
+  ::
+/-  *dns, *sole
+/+  *generators
+:-  %ask
+|=  $:  [now=@da eny=@uvJ bec=beak]
+        [arg=$@(~ [addr=@if ~])]
+        ~
+    ==
+^-  (sole-result [%dns-command command])
+=*  our  p.bec
+=-  ?~  arg  -
+    (fun.q.q addr.arg)
+%+  prompt
+  [%& %dns-address "ipv4 address: "]
+%+  parse
+  `$-(nail (like @if))`;~(pfix dot lip:ag)
+|=  addr=@if
+%-  produce
+[%dns-command %ip %if addr]
diff --git a/mar/dns/bind.hoon b/mar/dns/bind.hoon
deleted file mode 100644
index 20eeaf202..000000000
--- a/mar/dns/bind.hoon
+++ /dev/null
@@ -1,11 +0,0 @@
-::
-::::  /mar/dns/bind/hoon
-  ::
-/-  dns
-=,  dns
-|_  [for=ship him=ship target]
-++  grab
-  |%
-  ++  noun  ,[for=ship him=ship target]
-  --
---
diff --git a/mar/dns/bond.hoon b/mar/dns/bond.hoon
deleted file mode 100644
index bcee09453..000000000
--- a/mar/dns/bond.hoon
+++ /dev/null
@@ -1,11 +0,0 @@
-::
-::::  /mar/dns/bond/hoon
-  ::
-/-  dns
-=,  dns
-|_  [for=ship him=ship turf]
-++  grab
-  |%
-  ++  noun  ,[for=ship him=ship turf]
-  --
---
diff --git a/mar/dns/command.hoon b/mar/dns/command.hoon
new file mode 100644
index 000000000..97bb521f2
--- /dev/null
+++ b/mar/dns/command.hoon
@@ -0,0 +1,10 @@
+::
+::::  /mar/dns/bind/hoon
+  ::
+/-  *dns
+|_  command
+++  grab
+  |%
+  ++  noun  command
+  --
+--
diff --git a/sur/dns.hoon b/sur/dns.hoon
index d55bcf456..c0be56871 100644
--- a/sur/dns.hoon
+++ b/sur/dns.hoon
@@ -53,4 +53,13 @@
       try=@ud
       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]
+  ==
 --
diff --git a/sys/vane/ames.hoon b/sys/vane/ames.hoon
index c717eade5..4cd12228b 100644
--- a/sys/vane/ames.hoon
+++ b/sys/vane/ames.hoon
@@ -1324,7 +1324,20 @@
       [[gad.fox [%give %send p.bon q.bon]] ~]
     ::
         %raki
-      :_  fox  [hen [%pass / %j %meet p.p.bon q.p.bon q.bon r.bon]]~
+      =*  our  p.p.bon
+      =*  her  q.p.bon
+      =/  moz=(list move)
+        [hen [%pass / %j %meet our her life=q.bon pass=r.bon]]~
+      ::  poke :dns with an indirect binding if her is a planet we're spnsoring
+      ::
+      =?  moz  ?&  ?=(%duke (clan:title her))
+                   ?=(%king (clan:title our))
+                   =(our (~(sein am [now fox ski]) our now her))
+               ==
+        =/  cmd  [%meet her]
+        =/  pok  [%dns %poke `cage`[%dns-command !>(cmd)]]
+        :_  moz  [hen [%pass / %g %deal [our our] pok]]
+      [moz fox]
     ::
         %sake
       =/  wir=wire