mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 10:02:47 +03:00
Hacky code to get king con to connect to King API server.
This commit is contained in:
Benjamin Summers
parent
caa3d7f33c
commit
c579335288
@ -85,7 +85,7 @@ data Cmd
|
||||
= CmdNew New Opts
|
||||
| CmdRun Run Opts
|
||||
| CmdBug Bug
|
||||
| CmdCon Word16
|
||||
| CmdCon FilePath
|
||||
deriving (Show)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
@ -172,12 +172,12 @@ pillFromURL = PillSourceURL <$> strOption
|
||||
<> value defaultPillURL
|
||||
<> help "URL to pill file")
|
||||
|
||||
pierPath :: Parser FilePath
|
||||
pierPath = strArgument (metavar "PIER" <> help "Path to pier")
|
||||
|
||||
new :: Parser New
|
||||
new = do
|
||||
nPierPath <- optional
|
||||
$ strArgument
|
||||
$ metavar "PIER"
|
||||
<> help "Path to pier"
|
||||
nPierPath <- optional pierPath
|
||||
|
||||
nBootType <- newComet <|> newFakeship <|> newFromKeyfile
|
||||
|
||||
@ -265,7 +265,7 @@ newShip = CmdNew <$> new <*> opts
|
||||
|
||||
runShip :: Parser Cmd
|
||||
runShip = do
|
||||
rPierPath <- strArgument (metavar "PIER" <> help "Path to pier")
|
||||
rPierPath <- pierPath
|
||||
o <- opts
|
||||
pure (CmdRun (Run{..}) o)
|
||||
|
||||
@ -281,9 +281,6 @@ valPill = do
|
||||
|
||||
pure ValidatePill{..}
|
||||
|
||||
pierPath :: Parser FilePath
|
||||
pierPath = strArgument (metavar "PIER" <> help "Path to pier")
|
||||
|
||||
keyfilePath :: Parser FilePath
|
||||
keyfilePath = strArgument (metavar "KEYFILE" <> help "Path to key file")
|
||||
|
||||
@ -344,11 +341,7 @@ bugCmd = fmap CmdBug
|
||||
)
|
||||
|
||||
conCmd :: Parser Cmd
|
||||
conCmd = do
|
||||
port <- argument auto ( metavar "PORT"
|
||||
<> help "Port of terminal server"
|
||||
)
|
||||
pure (CmdCon port)
|
||||
conCmd = CmdCon <$> pierPath
|
||||
|
||||
allFx :: Parser Bug
|
||||
allFx = do
|
||||
|
||||
@ -72,8 +72,9 @@ import Control.Concurrent (myThreadId, runInBoundThread)
|
||||
import Control.Exception (AsyncException(UserInterrupt))
|
||||
import Control.Lens ((&))
|
||||
import Data.Default (def)
|
||||
import King.App (runApp, runPierApp)
|
||||
import King.App (runApp, runPierApp, HasConfigDir(..))
|
||||
import System.Environment (getProgName)
|
||||
import System.Exit (exitSuccess)
|
||||
import System.Posix.Signals (Handler(Catch), installHandler, sigTERM)
|
||||
import System.Random (randomIO)
|
||||
import Text.Show.Pretty (pPrint)
|
||||
@ -138,7 +139,9 @@ toNetworkConfig CLI.Opts{..} = NetworkConfig
|
||||
, ncAmesPort = oAmesPort
|
||||
}
|
||||
|
||||
tryBootFromPill :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
|
||||
tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e
|
||||
, HasConfigDir e
|
||||
)
|
||||
=> Bool -> Pill -> Bool -> Serf.Flags -> Ship
|
||||
-> LegacyBootEvent
|
||||
-> RIO e ()
|
||||
@ -152,7 +155,9 @@ tryBootFromPill oExit pill lite flags ship boot =
|
||||
rio $ logTrace "Completed boot"
|
||||
pure sls
|
||||
|
||||
runOrExitImmediately :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
|
||||
runOrExitImmediately :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e
|
||||
, HasConfigDir e
|
||||
)
|
||||
=> RAcquire e (Serf e, Log.EventLog, SerfState)
|
||||
-> Bool
|
||||
-> RIO e ()
|
||||
@ -170,7 +175,9 @@ runOrExitImmediately getPier oExit =
|
||||
runPier sls = do
|
||||
runRAcquire $ Pier.pier sls
|
||||
|
||||
tryPlayShip :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
|
||||
tryPlayShip :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e
|
||||
, HasConfigDir e
|
||||
)
|
||||
=> Bool -> Bool -> Serf.Flags -> RIO e ()
|
||||
tryPlayShip exitImmediately fullReplay flags = do
|
||||
when fullReplay wipeSnapshot
|
||||
@ -471,23 +478,23 @@ main = do
|
||||
installHandler sigTERM (Catch onTermSig) Nothing
|
||||
|
||||
CLI.parseArgs >>= \case
|
||||
CLI.CmdRun r o -> runShip r o
|
||||
CLI.CmdNew n o -> runApp $ newShip n o
|
||||
CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax
|
||||
CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax
|
||||
CLI.CmdBug (CLI.ValidatePill pax pil seq) -> runApp $ testPill pax pil seq
|
||||
CLI.CmdBug (CLI.ValidateEvents pax f l) -> runApp $ checkEvs pax f l
|
||||
CLI.CmdBug (CLI.ValidateFX pax f l) -> runApp $ checkFx pax f l
|
||||
CLI.CmdBug (CLI.CheckDawn pax) -> runApp $ checkDawn pax
|
||||
CLI.CmdBug CLI.CheckComet -> runApp $ checkComet
|
||||
CLI.CmdCon port -> runApp $ connTerm port
|
||||
CLI.CmdRun r o -> runShip r o
|
||||
CLI.CmdNew n o -> runApp $ newShip n o
|
||||
CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax
|
||||
CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax
|
||||
CLI.CmdBug (CLI.ValidatePill pax pil s) -> runApp $ testPill pax pil s
|
||||
CLI.CmdBug (CLI.ValidateEvents pax f l) -> runApp $ checkEvs pax f l
|
||||
CLI.CmdBug (CLI.ValidateFX pax f l) -> runApp $ checkFx pax f l
|
||||
CLI.CmdBug (CLI.CheckDawn pax) -> runApp $ checkDawn pax
|
||||
CLI.CmdBug CLI.CheckComet -> runApp $ checkComet
|
||||
CLI.CmdCon pier -> runApp $ connTerm pier
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
connTerm :: ∀e. HasLogFunc e => Word16 -> RIO e ()
|
||||
connTerm port =
|
||||
Term.runTerminalClient (fromIntegral port)
|
||||
connTerm :: ∀e. HasLogFunc e => FilePath -> RIO e ()
|
||||
connTerm pier =
|
||||
Term.runTerminalClient pier
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -1,3 +1,9 @@
|
||||
{-
|
||||
TODO This has a bunch of stub logic that was intended for an
|
||||
architecture with a single Urbit daemon running multiple
|
||||
ships. Do it or strip it out.
|
||||
-}
|
||||
|
||||
module King.API (kingAPI, readPortsFile) where
|
||||
|
||||
import UrbitPrelude
|
||||
@ -7,7 +13,7 @@ import RIO.Directory
|
||||
import King.App (HasConfigDir(..))
|
||||
import Network.Socket (Socket)
|
||||
import Prelude (read)
|
||||
import Vere.LockFile (lockFile)
|
||||
-- rt Vere.LockFile (lockFile)
|
||||
|
||||
import qualified Network.HTTP.Types as H
|
||||
import qualified Network.Wai as W
|
||||
@ -70,7 +76,7 @@ readPortsFile :: HasConfigDir e => RIO e (Maybe Word)
|
||||
readPortsFile = do
|
||||
(_, fil) <- portsFilePath
|
||||
bs <- readFile fil
|
||||
evaluate (read $ unpack $ decodeUtf8 bs)
|
||||
evaluate (readMay $ unpack $ decodeUtf8 bs)
|
||||
|
||||
kingServer :: HasLogFunc e => (Int, Socket) -> RAcquire e King
|
||||
kingServer is =
|
||||
@ -90,7 +96,7 @@ kingAPI :: (HasConfigDir e, HasLogFunc e)
|
||||
kingAPI = do
|
||||
(port, sock) <- io $ W.openFreePort
|
||||
(dir, fil) <- portsFile (fromIntegral port)
|
||||
lockFile dir
|
||||
-- lockFile dir
|
||||
kingServer (port, sock)
|
||||
|
||||
stubStatus :: StatusResp
|
||||
|
||||
@ -87,7 +87,7 @@ wsClient por = do
|
||||
-- logDebug "NOUNSERV (wsClie) Trying to connect"
|
||||
|
||||
tid <- io $ async
|
||||
$ WS.runClient "127.0.0.1" por "/"
|
||||
$ WS.runClient "127.0.0.1" por "/terminal/~zod/1"
|
||||
$ runRIO env . wsConn "NOUNSERV (wsClie) " inp out
|
||||
|
||||
pure $ Client con tid
|
||||
|
||||
@ -12,6 +12,7 @@ import System.Random
|
||||
import Vere.Pier.Types
|
||||
|
||||
import Data.Text (append)
|
||||
import King.App (HasConfigDir(..))
|
||||
import System.Posix.Files (ownerModes, setFileMode)
|
||||
import Vere.Ames (ames)
|
||||
import Vere.Behn (behn)
|
||||
@ -23,6 +24,7 @@ import Vere.Serf (Serf, SerfState(..), doJob, sStderr)
|
||||
|
||||
import RIO.Directory
|
||||
|
||||
import qualified King.API as King
|
||||
import qualified System.Console.Terminal.Size as TSize
|
||||
import qualified System.Entropy as Ent
|
||||
import qualified Urbit.Time as Time
|
||||
@ -140,7 +142,7 @@ resumed flags = do
|
||||
acquireWorker :: RIO e () -> RAcquire e (Async ())
|
||||
acquireWorker act = mkRAcquire (async act) cancel
|
||||
|
||||
pier :: ∀e. (HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
|
||||
pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
|
||||
=> (Serf e, EventLog, SerfState)
|
||||
-> RAcquire e ()
|
||||
pier (serf, log, ss) = do
|
||||
@ -150,6 +152,8 @@ pier (serf, log, ss) = do
|
||||
saveM <- newEmptyTMVarIO
|
||||
shutdownM <- newEmptyTMVarIO
|
||||
|
||||
_api ← King.kingAPI
|
||||
|
||||
let shutdownEvent = putTMVar shutdownM ()
|
||||
|
||||
inst <- io (KingId . UV . fromIntegral <$> randomIO @Word16)
|
||||
|
||||
@ -21,6 +21,8 @@ import UrbitPrelude hiding (getCurrentTime)
|
||||
import Vere.Pier.Types
|
||||
|
||||
import Data.List ((!!))
|
||||
import King.API (readPortsFile)
|
||||
import King.App (HasConfigDir(..))
|
||||
import RIO.Directory (createDirectoryIfMissing)
|
||||
import Vere.Term.API (Client(Client))
|
||||
|
||||
@ -156,10 +158,16 @@ connectToRemote port local = mkRAcquire start stop
|
||||
|
||||
pure (ferry, cAsync)
|
||||
|
||||
runTerminalClient :: ∀e. HasLogFunc e => Port -> RIO e ()
|
||||
runTerminalClient port = runRAcquire $ do
|
||||
data HackConfigDir = HCD { _hcdPax :: FilePath }
|
||||
makeLenses ''HackConfigDir
|
||||
instance HasConfigDir HackConfigDir where configDirL = hcdPax
|
||||
|
||||
runTerminalClient :: ∀e. HasLogFunc e => FilePath -> RIO e ()
|
||||
runTerminalClient pier = runRAcquire $ do
|
||||
mPort <- runRIO (HCD pier) readPortsFile
|
||||
port <- maybe (error "Can't connect") pure mPort
|
||||
(tsize, local) <- localClient
|
||||
(tid1, tid2) <- connectToRemote port local
|
||||
(tid1, tid2) <- connectToRemote (Port $ fromIntegral port) local
|
||||
atomically $ waitSTM tid1 <|> waitSTM tid2
|
||||
where
|
||||
runRAcquire :: RAcquire e () -> RIO e ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user