::  Ping our sponsorship tree regularly for routing.
::
::  To traverse NAT, we need the response to come back from someone
::  we've sent a message to.  We ping our sponsor so that they know
::  where we are.  However, we also need to ping our galaxy because if
::  the other ship tries to respond directly, it may be blocked by our
::  firewall or NAT.  Thus, the response must come from a ship we've
::  messaged directly, and the only one we can guarantee is our galaxy.
::  Note this issue manifests itself even for bootstrapping a planet to
::  talk to its own star.
::
/+  default-agent, verb, dbug
=*  point  point:kale
::
|%
::  How often to ping our sponsor when we might be behind a NAT.
::
::    NAT timeouts are often pretty short for UDP entries.  5 minutes is
::    a common value.  We use 25 seconds, same as Wireguard.
::
++  nat-timeout  ~s25
::
::  How often to check our IP when we know we're not behind a NAT.
::
++  ip-timeout   ~m5
::
::  Chosen because it's run by Cloudflare, and others I tried were
::  inconsistently slow.
::
++  ip-reflector  'https://icanhazip.com'
::
+$  card  card:agent:gall
+$  ship-state
  $%  [%idle ~]
      [%poking ~]
      [%http until=@da]
      [%waiting until=@da]
  ==
+$  state-2
  $:  %2
      ships=(set ship)
      nonce=@ud
      $=  plan
      $~  [%nat ~]
      $%  [%nat ~]
          [%pub ip=(unit @t)]
          [%off ~]
          [%one ~]
      ==
  ==
--
::
%-  agent:dbug
::
=|  state=state-2
=>  |%
    ::  Bind for the the writer monad on (quip effect state)
    ::
    ++  rind
      |*  [effect=mold state=*]
      |*  state-type=mold
      |=  $:  m-b=(quip effect state-type)
              fun=$-(state-type (quip effect state-type))
          ==
      ^-  (quip effect state-type)
      =^  effects-1=(list effect)  state  m-b
      =^  effects-2=(list effect)  state  (fun state)
      [(weld effects-1 effects-2) state]
    ::
    ++  once
      |=  =cord
      =(cord (scot %uw nonce.state))
    ::
    ::  Subsystem to keep track of which ships to ping across breaches
    ::  and sponsorship changes
    ::
    ++  ships
      =|  force=_|
      |%
      ++  rind  (^rind card state)
      ++  kick
        |=  [our=@p now=@da]
        ^-  (quip card _state)
        ::  ?:  =(%czar (clan:title our))
        ::    `state
        ::
        ::  NB: !! This includes our own ship, and for moons, this is
        ::  what has caused Jael to fetch our own rift from our parent.
        ::  This role may be taken by Ames's subscription to
        ::  %public-keys, but this must be tested before changing the
        ::  behavior here.
        ::
        =/  new-ships  (~(gas in *(set ship)) (saxo:title our now our))
        =/    removed  (~(dif in ships.state) new-ships)
        =/      added  (~(dif in new-ships) ships.state)
        ;<  new-state=_state  rind
          ?~  removed  `state
          [[%pass /jael %arvo %j %nuke removed]~ state]
        =.  state  new-state
        ::
        ;<  new-state=_state  rind
          ?~  added  `state
          [[%pass /jael %arvo %j %public-keys added]~ state]
        =.  state  new-state
        ::
        ::  Kick even if ships weren't added or removed
        ::
        (kick-pings our now new-ships force)
      ::
      ::  Kick whenever we get a response.  We really care about
      ::  breaches and sponsorship changes.
      ::
      ::  Delay until next event in case of breach, so that ames can
      ::  clear its state.
      ::
      ++  take-jael
        |=  now=@da
        ^-  (quip card _state)
        [[%pass /jael/delay %arvo %b %wait now]~ state]
      ::
      ++  take-delay  %*(kick ships force %.y)
      --
    ::
    ::  Starts pinging a new set of `ships`.
    ::
    ++  kick-pings
      |=  [our=@p now=@da ships=(set ship) force=?]
      ^-  (quip card _state)
      =:  nonce.state  +(nonce.state)
          ships.state  ships
        ==
      ::
      ?:  force  (kick:nat our)
      ?-  -.plan.state
        %off  `state
        %nat  (kick:nat our)
        %one  (kick:one our)
        %pub  (kick:pub our now)
      ==
    ::
    ::  Subsystem for pinging our sponsors when we might be behind a NAT
    ::    XX  no longer true if using STUN-enabled vere 2.XX
    ::    Ping each ship every 25 seconds to keep the pinhole open.
    ::    This is expensive, but if you don't do it and you are behind a
    ::    NAT, you will stop receiving packets from other ships except
    ::    during the 30 seconds following each packet you send.
    ::
    ++  nat
      ?>  ?=(%nat -.plan.state)
      |%
      ++  rind  (^rind card state)
      ++  kick
        |=  our=@p
        ^-  (quip card _state)
        =/  ships  ~(tap in ships.state)
        |-  ^-  (quip card _state)
        ?~  ships  `state
        ?:  =(our i.ships)  $(ships t.ships)
        ;<  new-state=_state  rind  (send-ping i.ships)
        =.  state  new-state
        $(ships t.ships)
      ::
      ++  send-ping
        |=  =ship
        ^-  (quip card _state)
        :_  state
        =/  wire  /nat/(scot %uw nonce.state)/ping/(scot %p ship)
        [%pass wire %agent [ship %ping] %poke %noun !>(~)]~
      ::
      ++  take-ping
        |=  [now=@da =wire error=(unit tang)]
        ^-  (quip card _state)
        ?.  ?=([%nat @ %ping @ ~] wire)  `state
        ?.  (once i.t.wire)  `state
        =/  ship  (slav %p i.t.t.t.wire)
        %-  (slog ?~(error ~ ['ping: got nack' >ship< u.error]))
        :_  state
        =/  wire  /nat/(scot %uw nonce.state)/wait/(scot %p ship)
        [%pass wire %arvo %b %wait (add nat-timeout now)]~
      ::
      ++  take-wait
        |=  =wire
        ^-  (quip card _state)
        ?.  ?=([%nat @ %wait @ ~] wire)  `state
        ?.  (once i.t.wire)  `state
        =/  ship  (slav %p i.t.t.t.wire)
        (send-ping ship)
      --
    ::
    ::  Subsystem for pinging our sponsors when we know we're not behind a NAT
    ::
    ::    Check our IP address every minute, and only if it changes,
    ::    ping all our sponsors.
    ::
    ++  pub
      ?>  ?=(%pub -.plan.state)
      |%
      ++  rind  (^rind card state)
      ++  kick
        |=  [our=@p now=@da]
        ^-  (quip card _state)
        ;<  new-state=_state  rind  (send-pings our)
        =.  state  new-state
        ::
        ;<  new-state=_state  rind  check-ip
        =.  state  new-state
        ::
        (set-timer now)
      ::
      ++  send-pings
        |=  our=@p
        ^-  (quip card _state)
        :_  state
        %+  murn  ~(tap in ships.state)
        |=  =ship
        ?:  =(our ship)
          ~
        =/  wire  /pub/(scot %uw nonce.state)/ping/(scot %p ship)
        `u=[%pass wire %agent [ship %ping] %poke %noun !>(~)]
      ::
      ++  take-pings
        |=  [=wire error=(unit tang)]
        ^-  (quip card _state)
        ?.  ?=([%pub @ %ping @ ~] wire)  `state
        ?.  (once i.t.wire)  `state
        =/  ship  (slav %p i.t.t.t.wire)
        %-  (slog ?~(error ~ ['ping: got nack' >ship< u.error]))
        `state
      ::
      ++  check-ip
        ^-  (quip card _state)
        :_  state
        =/  wire  /pub/(scot %uw nonce.state)/ip
        =/  =request:http  [%'GET' ip-reflector ~ ~]
        [%pass wire %arvo %i %request request *outbound-config:iris]~
      ::
      ++  take-ip
        |=  [our=@p =wire resp=client-response:iris]
        ^-  (quip card _state)
        ?.  ?=([%pub @ %ip ~] wire)  `state
        ?.  (once i.t.wire)  `state
        ::
        ?.  ?=(%finished -.resp)  `state  :: will retry in a minute
        ?.  ?=(%200 status-code.response-header.resp)
          =*  s  status-code.response-header.resp
          %-  (slog leaf+"ping: ip check failed: {<s>}" ~)
          `state
        ::
        ?~  full-file.resp
          %-  (slog 'ping: ip check body empty' ~)
          `state
        ::
        =*  body  q.data.u.full-file.resp
        ?~  body
          %-  (slog 'ping: ip check body empty' ~)
          `state
        ::
        =/  ip  (end [3 (dec (met 3 body))] body)
        ?:  =(ip.plan.state `ip)  `state
        ::
        =.  ip.plan.state  `ip
        (send-pings our)
      ::
      ++  set-timer
        |=  now=@da
        ^-  (quip card _state)
        =/  =wire  /pub/(scot %uw nonce.state)/wait
        [[%pass wire %arvo %b %wait (add ip-timeout now)]~ state]
      ::
      ++  take-wait
        |=  [our=@p now=@da =wire]
        ^-  (quip card _state)
        ?.  ?=([%pub @ %wait ~] wire)  `state
        ?.  (once i.t.wire)  `state
        ;<  new-state=_state  rind  check-ip
        =.  state  new-state
        ::
        (set-timer now)
      --
    ::  Subsystem for formally acknowledging a change in our IP:PORT
    ::
    ::    If our sponsor sends a STUN response, with an IP different than what
    ::    we had previously cached, we formally acknowledge this change by
    ::    sending one %poke to every ship in the sponsorship chain.
    ::
    ++  one
      ?>  ?=(%one -.plan.state)
      |%
      ++  kick
        |=  our=@p
        ^-  (quip card _state)
        :_  state
        %-  ~(rep in ships.state)
        |=  [=ship cards=(list card)]
        ?:  =(our ship)  cards
        =/  wire  /one/(scot %uw nonce.state)/ping/(scot %p ship)
        :_  cards  ^-  card
        [%pass wire %agent [ship %ping] %poke %noun !>(~)]
      --
    --
%+  verb  |
^-  agent:gall
|_  =bowl:gall
+*  this  .
    def  ~(. (default-agent this %|) bowl)
::
::  +on-init: initializing on startup
::
++  on-init
  ^-  [(list card) _this]
  =.  plan.state  [%nat ~]
  =^  cards  state  (kick:ships our.bowl now.bowl)
  [cards this]
::
++  on-save   !>(state)
++  on-load
  |=  old-vase=vase
  |^
  =/  old  !<(state-any old-vase)
  =?  old  ?=(%0 -.old)  (state-0-to-1 old)
  =?  old  ?=(%1 -.old)  (state-1-to-2 old)
  ?>  ?=(%2 -.old)
  =.  state  old
  =^  cards  state  (kick:ships our.bowl now.bowl)
  [cards this]
  ::
  +$  state-any  $%(state-0 state-1 state-2)
  +$  state-0    [%0 ships=(map ship [=rift =ship-state])]
  +$  state-1
    $:  %1
        ships=(set ship)
        nonce=@ud
        $=  plan
        $~  [%nat ~]
        $%  [%nat ~]
            [%pub ip=(unit @t)]
    ==  ==
  ::
  ++  state-0-to-1
    |=  old=state-0
    ^-  state-1
    [%1 ~ 0 %nat ~]
  ::
  ++  state-1-to-2
    |=  old=state-1
    ^-  state-2
    old(- %2)
  --
::  +on-poke: positively acknowledge pokes
::
++  on-poke
  |=  [=mark =vase]
  ?.  =(our src):bowl    :: don't crash, this is where pings are handled
    `this
  ::
  =^  cards  state
    ?:  ?=([%kick ?] q.vase)
      :: NB: ames calls this on %born (with fail=%.n) and after not hearing STUN
      ::  responses for more than ~s5 (with fail=%.y)
      ::
      ::  if %ping was turned off (due to a successfull STUN) but we failed
      ::  to get a STUN response in time switch to %nat and start a ~s25 timer
      ::
      ::  if the %kick has fail=%.n (e.g. for every %born), the plan will remain
      ::  unchanged, but we will innitiate a new round of %poke pings with
      ::  increasing nonce.
      ::
      ::  if we get repeated [%stun fail=&], but we are already in either %nat
      ::  or %pub, do nothing, since there are already timers in place to %ping
      ::  repeatedly.
      ::
      =/  stun-failed=?  &(?=([%off ~] plan.state) =(+.q.vase %.y))
      ?:  &(?=([%off ~] plan.state) =(+.q.vase %.n))
        ::  ignore restarts if we were already STUNning, if ip:port changed
        ::  %once will trigger one formal %ping
        ::
        `state
      =?  plan.state  stun-failed
        [%nat ~]
      ?:  &(!stun-failed =(+.q.vase %.y))
        `state
      (kick:ships our.bowl now.bowl)
    ?:  =(q.vase %stop)  :: NB: ames calls this on [%stun fail=%.n]
      =.  plan.state  [%off ~]
      (kick:ships our.bowl now.bowl)
    ?:  &(=(q.vase %once) =(%off -.plan.state))  :: NB: ames calls this on %once
      =.  plan.state  [%one ~]
      (kick:ships our.bowl now.bowl)
    ?:  =(q.vase %nat)
      =.  plan.state  [%nat ~]
      (kick:ships our.bowl now.bowl)
    ?:  =(q.vase %no-nat)
      =.  plan.state  [%pub ~]
      (kick:ships our.bowl now.bowl)
    `state
  [cards this]
::
++  on-watch  on-watch:def
++  on-leave  on-leave:def
++  on-peek
  |=  =path
  ^-  (unit (unit cage))
  ``noun+!>(state)
::  +on-agent: handle ames ack
::
++  on-agent
  |=  [=wire =sign:agent:gall]
  ^-  [(list card) _this]
  =^  cards  state
    ?+    wire  `state
        [%nat *]
      ?.  ?=(%nat -.plan.state)  `state
      ?.  ?=(%poke-ack -.sign)   `state
      (take-ping:nat now.bowl wire p.sign)
    ::
        [%pub *]
      ?.  ?=(%pub -.plan.state)  `state
      ?.  ?=(%poke-ack -.sign)   `state
      (take-pings:pub wire p.sign)
    ::
        [%one *]
      ?.  ?=(%one -.plan.state)  `state
      ?:  ?=(%poke-ack -.sign)   `state
      :: XX handle error?
      `state
    ==
  [cards this]
::  +on-arvo: handle timer firing
::
++  on-arvo
  |=  [=wire =sign-arvo]
  ^-  [(list card) _this]
  =^  cards  state
    ?+    wire  `state
        [%jael %delay ~]
      ?>  ?=(%wake +<.sign-arvo)
      ?^  error.sign-arvo
        %-  (slog 'ping: strange jael wake fail!' u.error.sign-arvo)
        `state
      (take-delay:ships our.bowl now.bowl)
    ::
        [%jael ~]
      ?>  ?=(%public-keys +<.sign-arvo)
      (take-jael:ships now.bowl)
    ::
        [%nat *]
      ?.  ?=(%nat -.plan.state)  `state
      ?>  ?=(%wake +<.sign-arvo)
      ?^  error.sign-arvo
        %-  (slog 'ping: strange nat wake fail!' u.error.sign-arvo)
        `state
      (take-wait:nat wire)
    ::
        [%pub @ %ip *]
      ?.  ?=(%pub -.plan.state)  `state
      ?>  ?=(%http-response +<.sign-arvo)
      (take-ip:pub our.bowl wire client-response.sign-arvo)
    ::
        [%pub @ %wait *]
      ?.  ?=(%pub -.plan.state)  `state
      ?>  ?=(%wake +<.sign-arvo)
      (take-wait:pub our.bowl now.bowl wire)
    ==
  [cards this]
::
++  on-fail   on-fail:def
--