natpmp: cleanup by using a tristate

pkg/hs/urbit-king/lib/Urbit/King/CLI.hs

@@ -19,7 +19,7 @@ import System.Environment (getProgName)
 data Host = Host
   { hSharedHttpPort  :: Maybe Word16
   , hSharedHttpsPort :: Maybe Word16
-  , hUseNatPmp       :: Maybe NatSetting
+  , hUseNatPmp       :: Nat
   }
  deriving (Show)
 
@@ -71,9 +71,10 @@ data PillSource
   | PillSourceURL String
   deriving (Show)
 
-data NatSetting
-  = NatSettingAlways
-  | NatSettingWhenPrivateNetwork
+data Nat
+  = NatAlways
+  | NatWhenPrivateNetwork
+  | NatNever
   deriving (Show)
 
 data New = New
@@ -432,17 +433,23 @@ host = do
     <> hidden
 
   hUseNatPmp <-
-     ( flag' (Just NatSettingAlways)
+     ( flag' NatAlways
      $ long "port-forwarding"
     <> help "Always try to search for a router to forward ames ports"
     <> hidden
      ) <|>
-     ( flag' Nothing
+     ( flag' NatNever
      $ long "no-port-forwarding"
     <> help "Disable trying to ask the router to forward ames ports"
     <> hidden
      ) <|>
-     (pure $ Just NatSettingWhenPrivateNetwork)
+     ( flag' NatWhenPrivateNetwork
+     $ long "port-forwarding-when-internal"
+    <> help ("Try asking the router to forward when ip is 192.168.0.0/24 or" <>
+             "10.0.0.0/8 (default).")
+    <> hidden
+     ) <|>
+     (pure $ NatWhenPrivateNetwork)
 
   pure (Host{..})
 

pkg/hs/urbit-king/lib/Urbit/King/Main.hs

@@ -590,15 +590,14 @@ runShip (CLI.Run pierPath) opts daemon = do
         mStart
 
 
-buildPortHandler :: HasLogFunc e => Maybe CLI.NatSetting -> RIO e PortControlApi
-buildPortHandler Nothing  = pure buildInactivePorts
+buildPortHandler :: HasLogFunc e => CLI.Nat -> RIO e PortControlApi
+buildPortHandler CLI.NatNever  = pure buildInactivePorts
 -- TODO: Figure out what to do about logging here. The "port: " messages are
 -- the sort of thing that should be put on the muxed terminal log, but we don't
 -- have that at this layer.
-buildPortHandler (Just CLI.NatSettingAlways) =
-  buildNatPorts TryNatAlways (io . hPutStrLn stderr . unpack)
-buildPortHandler (Just CLI.NatSettingWhenPrivateNetwork) =
-  buildNatPorts TryNatWhenPrivate (io . hPutStrLn stderr . unpack)
+buildPortHandler CLI.NatAlways = buildNatPorts (io . hPutStrLn stderr . unpack)
+buildPortHandler CLI.NatWhenPrivateNetwork =
+  buildNatPortsWhenPrivate (io . hPutStrLn stderr . unpack)
 
 startBrowser :: HasLogFunc e => FilePath -> RIO e ()
 startBrowser pierPath = runRAcquire $ do

pkg/hs/urbit-king/lib/Urbit/Vere/Ports.hs

@@ -1,7 +1,7 @@
 module Urbit.Vere.Ports (HasPortControlApi(..),
                          PortControlApi,
-                         TryNat(..),
                          buildInactivePorts,
+                         buildNatPortsWhenPrivate,
                          buildNatPorts,
                          requestPortAccess) where
 
@@ -31,24 +31,23 @@ buildInactivePorts = PortControlApi noop noop
  where
   noop x = pure ()
 
-data TryNat
-  = TryNatAlways
-  | TryNatWhenPrivate
+-- | Builds a PortControlApi struct which tries to hole-punch by talking to the
+-- NAT gateway over NAT-PMP iff we are on a private network ip.
+buildNatPortsWhenPrivate :: (HasLogFunc e)
+                         => (Text -> RIO e ())
+                         -> RIO e PortControlApi
+buildNatPortsWhenPrivate stderr = do
+  behind <- likelyBehindRouter
+  if behind
+    then buildNatPorts stderr
+    else pure buildInactivePorts
 
 -- | Builds a PortControlApi struct which tries to hole-punch by talking to the
 -- NAT gateway over NAT-PMP.
 buildNatPorts :: (HasLogFunc e)
-              => TryNat
-              -> (Text -> RIO e ())
+              => (Text -> RIO e ())
               -> RIO e PortControlApi
-
-buildNatPorts TryNatWhenPrivate stderr = do
-  behind <- likelyBehindRouter
-  if behind
-    then buildNatPorts TryNatAlways stderr
-    else pure buildInactivePorts
-
-buildNatPorts TryNatAlways stderr = do
+buildNatPorts stderr = do
   q <- newTQueueIO
   async $ portThread q stderr