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 :: PortControlApi
-buildInactivePorts = pure $ PortControlApi noop noop
+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 -----------------------------------------------------------------------
 
@@ -43,6 +45,7 @@ sendEf g w bs = NewtEfSend (0, ()) (EachYes g) bs
 data NetworkTestApp = NetworkTestApp
     { _ntaLogFunc        :: !LogFunc
     , _ntaNetworkConfig  :: !NetworkConfig
+    , _ntaPortControlApi :: PortControlApi
     , _ntaKingId         :: !Word16
     }
 
@@ -57,10 +60,15 @@ 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
+runNetworkApp =
+  runRIO NetworkTestApp
     { _ntaLogFunc        = mkLogFunc (\_ _ _ _ -> pure ())
     , _ntaKingId         = 34
+    , _ntaPortControlApi = buildInactivePorts
     , _ntaNetworkConfig  = NetworkConfig { _ncNetMode   = NMNormal
                                          , _ncAmesPort  = Nothing
                                          , _ncNoAmes    = False
@@ -110,8 +118,7 @@ sendThread cb (to, val) = void $ mkRAcquire start cancel
 zodSelfMsg :: Property
 zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest)
  where
-  runTest
+  runTest :: (HasAmes e) => Bytes -> RIO e Bool
-    :: (HasLogFunc e, HasNetworkConfig e, HasKingId 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)
+    runTest :: (HasAmes e) => (Word8, Word8, Bytes) -> RIO e Bool
-            => (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)
+    go :: (HasAmes e) => Word8 -> Word8 -> Bytes -> RIO e Bool
-       => Word8 -> Word8 -> Bytes -> RIO e Bool
     go aliceShip bobShip val = runRAcquire $ do
         (aliceQ, alice) <- runGala aliceShip
         (bobQ,   bob)   <- runGala bobShip