king: Flags to disable HTTP/HTTPS/UDP per-ship.

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

@@ -29,6 +29,9 @@ data Opts = Opts
     , oDryFrom      :: Maybe Word64
     , oVerbose      :: Bool
     , oAmesPort     :: Maybe Word16
+    , oNoAmes       :: Bool
+    , oNoHttp       :: Bool
+    , oNoHttps      :: Bool
     , oTrace        :: Bool
     , oCollectFx    :: Bool
     , oLocalhost    :: Bool
@@ -227,6 +230,24 @@ opts = do
       <> help "Ames port"
       <> hidden
 
+    oNoAmes <-
+     switch
+     $  long "no-ames"
+     <> help "Run with Ames disabled."
+     <> hidden
+
+    oNoHttp <-
+     switch
+     $  long "no-http"
+     <> help "Run with HTTP disabled."
+     <> hidden
+
+    oNoHttps <-
+     switch
+     $  long "no-https"
+     <> help "Run with HTTPS disabled."
+     <> hidden
+
     oHttpPort <-
       optional
       $  option auto

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

@@ -36,6 +36,9 @@ data NetMode
 data NetworkConfig = NetworkConfig
   { _ncNetMode    :: NetMode
   , _ncAmesPort   :: Maybe Word16
+  , _ncNoAmes     :: Bool
+  , _ncNoHttp     :: Bool
+  , _ncNoHttps    :: Bool
   , _ncHttpPort   :: Maybe Word16
   , _ncHttpsPort  :: Maybe Word16
   , _ncLocalPort  :: Maybe Word16

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

@@ -165,6 +165,9 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. }
   _ncHttpPort  = oHttpPort
   _ncHttpsPort = oHttpsPort
   _ncLocalPort = oLoopbackPort
+  _ncNoAmes    = oNoAmes
+  _ncNoHttp    = oNoHttp
+  _ncNoHttps   = oNoHttps
 
 tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e
                    , HasConfigDir e, HasStderrLogFunc e

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

@@ -70,14 +70,15 @@ hearEv p a bs =
 --------------------------------------------------------------------------------
 
 netMode :: HasNetworkConfig e => Bool -> RIO e NetworkMode
-netMode True  = pure Fake
-netMode False = view (networkConfigL . ncNetMode . to cvt)
- where
-  cvt :: NetMode -> NetworkMode
-  cvt = \case
-    NMNormal    -> Real
-    NMLocalhost -> Localhost
-    NMNone      -> NoNetwork
+netMode isFake = do
+  netMode <- view (networkConfigL . ncNetMode)
+  noAmes  <- view (networkConfigL . ncNoAmes)
+  pure $ case (noAmes, isFake, netMode) of
+    (True, _   , _          ) -> NoNetwork
+    (_   , _   , NMNone     ) -> NoNetwork
+    (_   , True, _          ) -> Fake
+    (_   , _   , NMNormal   ) -> Real
+    (_   , _   , NMLocalhost) -> Localhost
 
 udpPort :: Bool -> Ship -> HasNetworkConfig e => RIO e PortNumber
 udpPort isFake who = do

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

@@ -201,6 +201,9 @@ startServ multi who isFake conf plan = do
   let soHost :: SockOpts -> ServHost
       soHost so = if soLocalhost so then SHLocalhost else SHAnyHostOk
 
+  noHttp  <- view (networkConfigL . ncNoHttp)
+  noHttps <- view (networkConfigL . ncNoHttps)
+
   let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM ()
       onReq which _ship reqId reqInfo =
         plan (requestEvent srvId which reqId reqInfo)
@@ -217,6 +220,7 @@ startServ multi who isFake conf plan = do
     { scHost = soHost (pttLop ptt)
     , scPort = soWhich (pttLop ptt)
     , scRedi = Nothing
+    , scFake = False
     , scType = STHttp who $ ReqApi
         { rcReq = onReq Loopback
         , rcKil = onKilReq
@@ -228,6 +232,7 @@ startServ multi who isFake conf plan = do
     { scHost = soHost (pttIns ptt)
     , scPort = soWhich (pttIns ptt)
     , scRedi = secRedi
+    , scFake = noHttp
     , scType = STHttp who $ ReqApi
         { rcReq = onReq Insecure
         , rcKil = onKilReq
@@ -240,6 +245,7 @@ startServ multi who isFake conf plan = do
       { scHost = soHost (pttSec ptt)
       , scPort = soWhich (pttSec ptt)
       , scRedi = Nothing
+      , scFake = noHttps
       , scType = STHttps who tls $ ReqApi
           { rcReq = onReq Secure
           , rcKil = onKilReq

pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs

@@ -101,6 +101,7 @@ multiEyre conf@MultiEyreConf {..} = do
       { scHost = host
       , scPort = SPChoices $ singleton $ fromIntegral por
       , scRedi = Nothing -- TODO
+      , scFake = False
       , scType = STMultiHttp $ ReqApi
           { rcReq = onReq Insecure
           , rcKil = onKil
@@ -113,6 +114,7 @@ multiEyre conf@MultiEyreConf {..} = do
       { scHost = host
       , scPort = SPChoices $ singleton $ fromIntegral por
       , scRedi = Nothing
+      , scFake = False
       , scType = STMultiHttps (MTC vTlsC) $ ReqApi
           { rcReq = onReq Secure
           , rcKil = onKil

pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs

@@ -29,6 +29,7 @@ module Urbit.Vere.Eyre.Serv
   , ServConf(..)
   , configCreds
   , serv
+  , fakeServ
   )
 where
 
@@ -98,6 +99,7 @@ data ServConf = ServConf
   , scHost :: ServHost
   , scPort :: ServPort
   , scRedi :: Maybe W.Port
+  , scFake :: Bool
   }
  deriving (Show)
 
@@ -282,9 +284,22 @@ configCreds TlsConfig {..} =
     Left  str -> Left (pack str)
     Right rs  -> Right rs
 
-serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi
-serv vLive conf@ServConf {..} = do
-  logTrace (displayShow ("EYRE", "SERV", "Start", conf))
+fakeServ :: HasLogFunc e => ServConf -> RIO e ServApi
+fakeServ conf = do
+  let por = fakePort (scPort conf)
+  logTrace (displayShow ("EYRE", "SERV", "Running Fake Server", por))
+  pure $ ServApi
+    { saKil = pure ()
+    , saPor = pure por
+    }
+ where
+  fakePort :: ServPort -> W.Port
+  fakePort SPAnyPort            = 55555
+  fakePort (SPChoices (x :| _)) = x
+
+realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi
+realServ vLive conf@ServConf {..} = do
+  logTrace (displayShow ("EYRE", "SERV", "Running Real Server"))
   kil <- newEmptyTMVarIO
   por <- newEmptyTMVarIO
 
@@ -301,3 +316,9 @@ serv vLive conf@ServConf {..} = do
     rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do
       atomically (putTMVar vPort por)
       startServer scType scHost por sok scRedi vLive
+
+serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi
+serv vLive conf = do
+  if scFake conf
+    then fakeServ conf
+    else realServ vLive conf