king: get tests passing after nat-pmp changes

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

@@ -475,7 +475,7 @@ newShip CLI.New{..} opts = do
 
   -- TODO: We hit the same problem as above: we need the running options to
   -- determine how to configure the ports
-  ports <- buildInactivePorts
+  let ports = buildInactivePorts
 
   -- here we are with a king env, and we now need a multi env.
   runRunningEnv multi ports go
@@ -591,7 +591,7 @@ runShip (CLI.Run pierPath) opts daemon = do
 
 
 buildPortHandler :: (HasLogFunc e) => Bool -> RIO e PortControlApi
-buildPortHandler False  = buildInactivePorts
+buildPortHandler False  = pure $ buildInactivePorts
 buildPortHandler True   = buildNATPorts
 
 startBrowser :: HasLogFunc e => FilePath -> RIO e ()

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

@@ -23,8 +23,8 @@ data PortControlApi = PortControlApi
   }
 
 -- Builds a Ports struct which does nothing when called.
-buildInactivePorts :: RIO e PortControlApi
-buildInactivePorts = pure $ PortControlApi noop noop
+buildInactivePorts :: PortControlApi
+buildInactivePorts = PortControlApi noop noop
   where
     noop x = pure ()
 

pkg/hs/urbit-king/test/AmesTests.hs

@@ -15,6 +15,7 @@ import Urbit.Noun.Time
 import Urbit.Prelude
 import Urbit.Vere.Ames
 import Urbit.Vere.Pier.Types
+import Urbit.Vere.Ports
 
 import Control.Concurrent (runInBoundThread)
 import Data.LargeWord     (LargeKey(..))
@@ -27,7 +28,8 @@ import qualified Urbit.EventLog.LMDB as Log
 
 --------------------------------------------------------------------------------
 
-type HasAmes e = (HasLogFunc e, HasNetworkConfig e, HasKingId e)
+type HasAmes e = (HasLogFunc e, HasNetworkConfig e, HasKingId e,
+                   HasPortControlApi e)
 
 -- Utils -----------------------------------------------------------------------
 
@@ -41,9 +43,10 @@ sendEf :: Galaxy -> Wen -> Bytes -> NewtEf
 sendEf g w bs = NewtEfSend (0, ()) (EachYes g) bs
 
 data NetworkTestApp = NetworkTestApp
-    { _ntaLogFunc       :: !LogFunc
-    , _ntaNetworkConfig :: !NetworkConfig
-    , _ntaKingId        :: !Word16
+    { _ntaLogFunc        :: !LogFunc
+    , _ntaNetworkConfig  :: !NetworkConfig
+    , _ntaPortControlApi :: PortControlApi
+    , _ntaKingId         :: !Word16
     }
 
 makeLenses ''NetworkTestApp
@@ -57,20 +60,25 @@ instance HasNetworkConfig NetworkTestApp where
 instance HasKingId NetworkTestApp where
   kingIdL = ntaKingId
 
+instance HasPortControlApi NetworkTestApp where
+  portControlApiL = ntaPortControlApi
+
 runNetworkApp :: RIO NetworkTestApp a -> IO a
-runNetworkApp = runRIO NetworkTestApp
-  { _ntaLogFunc       = mkLogFunc (\_ _ _ _ -> pure ())
-  , _ntaKingId        = 34
-  , _ntaNetworkConfig = NetworkConfig { _ncNetMode   = NMNormal
-                                      , _ncAmesPort  = Nothing
-                                      , _ncNoAmes    = False
-                                      , _ncNoHttp    = False
-                                      , _ncNoHttps   = False
-                                      , _ncHttpPort  = Nothing
-                                      , _ncHttpsPort = Nothing
-                                      , _ncLocalPort = Nothing
-                                      }
-  }
+runNetworkApp =
+  runRIO NetworkTestApp
+    { _ntaLogFunc        = mkLogFunc (\_ _ _ _ -> pure ())
+    , _ntaKingId         = 34
+    , _ntaPortControlApi = buildInactivePorts
+    , _ntaNetworkConfig  = NetworkConfig { _ncNetMode   = NMNormal
+                                         , _ncAmesPort  = Nothing
+                                         , _ncNoAmes    = False
+                                         , _ncNoHttp    = False
+                                         , _ncNoHttps   = False
+                                         , _ncHttpPort  = Nothing
+                                         , _ncHttpsPort = Nothing
+                                         , _ncLocalPort = Nothing
+                                         }
+    }
 
 runGala
   :: forall e
@@ -110,8 +118,7 @@ sendThread cb (to, val) = void $ mkRAcquire start cancel
 zodSelfMsg :: Property
 zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest)
  where
-  runTest
-    :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) => Bytes -> RIO e Bool
+  runTest :: (HasAmes e) => Bytes -> RIO e Bool
   runTest val = runRAcquire $ do
     env         <- ask
     (zodQ, zod) <- runGala 0
@@ -121,15 +128,13 @@ zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest)
 twoTalk :: Property
 twoTalk = forAll arbitrary (ioProperty . runNetworkApp . runTest)
   where
-    runTest :: (HasLogFunc e, HasNetworkConfig e, HasKingId e)
-            => (Word8, Word8, Bytes) -> RIO e Bool
+    runTest :: (HasAmes e) => (Word8, Word8, Bytes) -> RIO e Bool
     runTest (aliceShip, bobShip, val) =
       if aliceShip == bobShip
         then pure True
         else go aliceShip bobShip val
 
-    go :: (HasLogFunc e, HasNetworkConfig e, HasKingId e)
-       => Word8 -> Word8 -> Bytes -> RIO e Bool
+    go :: (HasAmes e) => Word8 -> Word8 -> Bytes -> RIO e Bool
     go aliceShip bobShip val = runRAcquire $ do
         (aliceQ, alice) <- runGala aliceShip
         (bobQ,   bob)   <- runGala bobShip