natpmp: Rename RunningEnv to HostEnv.

This commit is contained in:
Elliot Glaysher 2020-08-13 10:19:35 -04:00
parent 3e6fd0f8e8
commit ac4b5a99e5
2 changed files with 50 additions and 50 deletions

View File

@ -9,8 +9,8 @@ module Urbit.King.App
, kingEnvKillSignal
, killKingActionL
, onKillKingSigL
, RunningEnv
, runRunningEnv
, HostEnv
, runHostEnv
, PierEnv
, runPierEnv
, killPierActionL
@ -20,7 +20,7 @@ module Urbit.King.App
, HasProcId(..)
, HasKingEnv(..)
, HasMultiEyreApi(..)
, HasRunningEnv(..)
, HasHostEnv(..)
, HasPierEnv(..)
, module Urbit.King.Config
)
@ -125,7 +125,7 @@ killKingActionL :: HasKingEnv e => Getter e (STM ())
killKingActionL =
kingEnvL . kingEnvKillSignal . to (\kil -> void (tryPutTMVar kil ()))
-- RunningEnv ------------------------------------------------------------------
-- HostEnv ------------------------------------------------------------------
-- The running environment is everything in King, eyre configuration shared
-- across ships, and IP information shared across ships.
@ -136,60 +136,60 @@ class HasMultiEyreApi a where
multiEyreApiL :: Lens' a MultiEyreApi
class (HasKingEnv a, HasMultiEyreApi a, HasPortControlApi a) =>
HasRunningEnv a where
runningEnvL :: Lens' a RunningEnv
HasHostEnv a where
hostEnvL :: Lens' a HostEnv
data RunningEnv = RunningEnv
{ _runningEnvKingEnv :: !KingEnv
, _runningEnvMultiEyreApi :: MultiEyreApi
, _runningEnvPortControlApi :: PortControlApi
data HostEnv = HostEnv
{ _hostEnvKingEnv :: !KingEnv
, _hostEnvMultiEyreApi :: MultiEyreApi
, _hostEnvPortControlApi :: PortControlApi
}
makeLenses ''RunningEnv
makeLenses ''HostEnv
instance HasKingEnv RunningEnv where
kingEnvL = runningEnvKingEnv
instance HasKingEnv HostEnv where
kingEnvL = hostEnvKingEnv
instance HasLogFunc RunningEnv where
instance HasLogFunc HostEnv where
logFuncL = kingEnvL . logFuncL
instance HasStderrLogFunc RunningEnv where
instance HasStderrLogFunc HostEnv where
stderrLogFuncL = kingEnvL . stderrLogFuncL
instance HasProcId RunningEnv where
instance HasProcId HostEnv where
procIdL = kingEnvL . procIdL
instance HasKingId RunningEnv where
instance HasKingId HostEnv where
kingIdL = kingEnvL . kingEnvKingId
instance HasMultiEyreApi RunningEnv where
multiEyreApiL = runningEnvMultiEyreApi
instance HasMultiEyreApi HostEnv where
multiEyreApiL = hostEnvMultiEyreApi
instance HasPortControlApi RunningEnv where
portControlApiL = runningEnvPortControlApi
instance HasPortControlApi HostEnv where
portControlApiL = hostEnvPortControlApi
-- Running Running Envs --------------------------------------------------------
runRunningEnv :: MultiEyreApi -> PortControlApi -> RIO RunningEnv ()
runHostEnv :: MultiEyreApi -> PortControlApi -> RIO HostEnv ()
-> RIO KingEnv ()
runRunningEnv multi ports action = do
runHostEnv multi ports action = do
king <- ask
let runningEnv = RunningEnv { _runningEnvKingEnv = king
, _runningEnvMultiEyreApi = multi
, _runningEnvPortControlApi = ports
let hostEnv = HostEnv { _hostEnvKingEnv = king
, _hostEnvMultiEyreApi = multi
, _hostEnvPortControlApi = ports
}
io (runRIO runningEnv action)
io (runRIO hostEnv action)
-- PierEnv ---------------------------------------------------------------------
class (HasKingEnv a, HasRunningEnv a, HasPierConfig a, HasNetworkConfig a) =>
class (HasKingEnv a, HasHostEnv a, HasPierConfig a, HasNetworkConfig a) =>
HasPierEnv a where
pierEnvL :: Lens' a PierEnv
data PierEnv = PierEnv
{ _pierEnvRunningEnv :: !RunningEnv
{ _pierEnvHostEnv :: !HostEnv
, _pierEnvPierConfig :: !PierConfig
, _pierEnvNetworkConfig :: !NetworkConfig
, _pierEnvKillSignal :: !(TMVar ())
@ -198,16 +198,16 @@ data PierEnv = PierEnv
makeLenses ''PierEnv
instance HasKingEnv PierEnv where
kingEnvL = pierEnvRunningEnv . kingEnvL
kingEnvL = pierEnvHostEnv . kingEnvL
instance HasRunningEnv PierEnv where
runningEnvL = pierEnvRunningEnv
instance HasHostEnv PierEnv where
hostEnvL = pierEnvHostEnv
instance HasMultiEyreApi PierEnv where
multiEyreApiL = pierEnvRunningEnv . multiEyreApiL
multiEyreApiL = pierEnvHostEnv . multiEyreApiL
instance HasPortControlApi PierEnv where
portControlApiL = pierEnvRunningEnv . portControlApiL
portControlApiL = pierEnvHostEnv . portControlApiL
instance HasPierEnv PierEnv where
pierEnvL = id
@ -250,11 +250,11 @@ killPierActionL =
-- Running Pier Envs -----------------------------------------------------------
runPierEnv
:: PierConfig -> NetworkConfig -> TMVar () -> RIO PierEnv a -> RIO RunningEnv a
:: PierConfig -> NetworkConfig -> TMVar () -> RIO PierEnv a -> RIO HostEnv a
runPierEnv pierConfig networkConfig vKill action = do
running <- ask
let pierEnv = PierEnv { _pierEnvRunningEnv = running
let pierEnv = PierEnv { _pierEnvHostEnv = running
, _pierEnvPierConfig = pierConfig
, _pierEnvNetworkConfig = networkConfig
, _pierEnvKillSignal = vKill

View File

@ -443,7 +443,7 @@ validateNounVal inpVal = do
--------------------------------------------------------------------------------
pillFrom :: CLI.PillSource -> RIO RunningEnv Pill
pillFrom :: CLI.PillSource -> RIO HostEnv Pill
pillFrom = \case
CLI.PillSourceFile pillPath -> do
logDebug $ display $ "boot: reading pill from " ++ (pack pillPath :: Text)
@ -479,9 +479,9 @@ newShip CLI.New{..} opts = do
let ports = buildInactivePorts
-- here we are with a king env, and we now need a multi env.
runRunningEnv multi ports go
runHostEnv multi ports go
where
go :: RIO RunningEnv ()
go :: RIO HostEnv ()
go = case nBootType of
CLI.BootComet -> do
pill <- pillFrom nPillSource
@ -515,7 +515,7 @@ newShip CLI.New{..} opts = do
bootFromSeed pill seed
shipFrom :: Text -> RIO RunningEnv Ship
shipFrom :: Text -> RIO HostEnv Ship
shipFrom name = case Ob.parsePatp name of
Left x -> error "Invalid ship name"
Right p -> pure $ Ship $ fromIntegral $ Ob.fromPatp p
@ -525,7 +525,7 @@ newShip CLI.New{..} opts = do
Just x -> x
Nothing -> "./" <> unpack name
nameFromShip :: Ship -> RIO RunningEnv Text
nameFromShip :: Ship -> RIO HostEnv Text
nameFromShip s = name
where
nameWithSig = Ob.renderPatp $ Ob.patp $ fromIntegral s
@ -533,7 +533,7 @@ newShip CLI.New{..} opts = do
Nothing -> error "Urbit.ob didn't produce string with ~"
Just x -> pure x
bootFromSeed :: Pill -> Seed -> RIO RunningEnv ()
bootFromSeed :: Pill -> Seed -> RIO HostEnv ()
bootFromSeed pill seed = do
ethReturn <- dawnVent seed
@ -547,7 +547,7 @@ newShip CLI.New{..} opts = do
-- Now that we have all the information for running an application with a
-- PierConfig, do so.
runTryBootFromPill :: Pill -> Text -> Ship -> LegacyBootEvent
-> RIO RunningEnv ()
-> RIO HostEnv ()
runTryBootFromPill pill name ship bootEvent = do
env <- ask
let vKill = (env ^. kingEnvL) ^. kingEnvKillSignal
@ -557,7 +557,7 @@ newShip CLI.New{..} opts = do
tryBootFromPill True pill nLite ship bootEvent
------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent
runShipEnv :: CLI.Run -> CLI.Opts -> TMVar () -> RIO PierEnv a -> RIO RunningEnv a
runShipEnv :: CLI.Run -> CLI.Opts -> TMVar () -> RIO PierEnv a -> RIO HostEnv a
runShipEnv (CLI.Run pierPath) opts vKill act = do
runPierEnv pierConfig netConfig vKill act
where
@ -689,7 +689,7 @@ main = do
TODO Use logging system instead of printing.
-}
runShipRestarting
:: CLI.Run -> CLI.Opts -> RIO RunningEnv ()
:: CLI.Run -> CLI.Opts -> RIO HostEnv ()
runShipRestarting r o = do
let pier = pack (CLI.rPierPath r)
loop = runShipRestarting r o
@ -722,7 +722,7 @@ runShipRestarting r o = do
TODO This is messy and shared a lot of logic with `runShipRestarting`.
-}
runShipNoRestart
:: CLI.Run -> CLI.Opts -> Bool -> RIO RunningEnv ()
:: CLI.Run -> CLI.Opts -> Bool -> RIO HostEnv ()
runShipNoRestart r o d = do
-- killing ship same as killing king
env <- ask
@ -761,9 +761,9 @@ runShips CLI.KingOpts {..} ships = do
ports <- buildPortHandler koUseNatPmp
runRunningEnv multi ports (go ships)
runHostEnv multi ports (go ships)
where
go :: [(CLI.Run, CLI.Opts, Bool)] -> RIO RunningEnv ()
go :: [(CLI.Run, CLI.Opts, Bool)] -> RIO HostEnv ()
go = \case
[] -> pure ()
[rod] -> runSingleShip rod
@ -771,7 +771,7 @@ runShips CLI.KingOpts {..} ships = do
-- TODO Duplicated logic.
runSingleShip :: (CLI.Run, CLI.Opts, Bool) -> RIO RunningEnv ()
runSingleShip :: (CLI.Run, CLI.Opts, Bool) -> RIO HostEnv ()
runSingleShip (r, o, d) = do
shipThread <- async (runShipNoRestart r o d)
@ -793,7 +793,7 @@ runSingleShip (r, o, d) = do
pure ()
runMultipleShips :: [(CLI.Run, CLI.Opts)] -> RIO RunningEnv ()
runMultipleShips :: [(CLI.Run, CLI.Opts)] -> RIO HostEnv ()
runMultipleShips ships = do
shipThreads <- for ships $ \(r, o) -> do
async (runShipRestarting r o)