urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 20:47:27 +03:00
Code Issues Packages Projects Releases Wiki Activity

natpmp: Rename RunningEnv to HostEnv.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
pkg/hs/urbit-king/lib/Urbit/King/App.hs
View File

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

28
pkg/hs/urbit-king/lib/Urbit/King/Main.hs
View File

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