From e9020c33e1303b8737e229321205c832637649b0 Mon Sep 17 00:00:00 2001 From: Ben Gamari <ben@smart-cactus.org> Date: Fri, 10 Dec 2021 13:48:11 -0500 Subject: [PATCH] s/Slave/Interpreter/ This terminology doesn't sit right with me. --- Main.hs | 50 +++++++++---------- iserv-proxy.cabal | 27 +++++----- src/IServ/Remote/{Slave.hs => Interpreter.hs} | 32 ++++++------ src/IServ/Remote/Message.hs | 37 +++++++------- 4 files changed, 75 insertions(+), 71 deletions(-) rename src/IServ/Remote/{Slave.hs => Interpreter.hs} (85%) diff --git a/Main.hs b/Main.hs index ccb9885..a4c0d04 100644 --- a/Main.hs +++ b/Main.hs @@ -4,14 +4,14 @@ This is the proxy portion of iserv. It acts as local bridge for GHC to call -a remote slave. This all might sound +a remote interpreter. This all might sound confusing, so let's try to get some naming down. GHC is the actual Haskell compiler, that acts as frontend to the code to be compiled. -iserv is the slave, that GHC delegates compilation +iserv is the interpreter, that GHC delegates compilation of TH to. As such it needs to be compiled for and run on the Target. In the special case where the Host and the Target are the same, @@ -77,9 +77,9 @@ dieWithUsage = do die $ prog ++ ": " ++ msg where #if defined(WINDOWS) - msg = "usage: iserv <write-handle> <read-handle> <slave ip> <slave port> [-v]" + msg = "usage: iserv <write-handle> <read-handle> <interpreter ip> <interpreter port> [-v]" #else - msg = "usage: iserv <write-fd> <read-fd> <slave ip> <slave port> [-v]" + msg = "usage: iserv <write-fd> <read-fd> <interpreter ip> <interpreter port> [-v]" #endif main :: IO () @@ -126,18 +126,18 @@ main = do trace "Starting proxy" proxy verbose in_pipe out_pipe --- | A hook, to transform outgoing (proxy -> slave) --- messages prior to sending them to the slave. +-- | A hook, to transform outgoing (proxy -> interpreter) +-- messages prior to sending them to the interpreter. hook :: Msg -> IO Msg hook = return --- | Forward a single @THMessage@ from the slave +-- | Forward a single @THMessage@ from the interpreter -- to ghc, and read back the result from GHC. -- --- @Message@s go from ghc to the slave. --- ghc --- proxy --> slave (@Message@) --- @THMessage@s go from the slave to ghc --- ghc <-- proxy --- slave (@THMessage@) +-- @Message@s go from ghc to the interpreter. +-- ghc --- proxy --> interpreter (@Message@) +-- @THMessage@s go from the interpreter to ghc +-- ghc <-- proxy --- interpreter (@THMessage@) -- fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a fwdTHMsg local msg = do @@ -161,24 +161,24 @@ fwdTHCall verbose local remote msg = do trace "fwdTHCall/loopTH: reading remote pipe..." THMsg msg' <- readPipe remote getTHMessage when verbose $ - trace ("| TH Msg: ghc <- proxy -- slave: " ++ show msg') + trace ("| TH Msg: ghc <- proxy -- interpreter: " ++ show msg') res <- fwdTHMsg local msg' when verbose $ - trace ("| Resp.: ghc -- proxy -> slave: " ++ show res) + trace ("| Resp.: ghc -- proxy -> interpreter: " ++ show res) writePipe remote (put res) case msg' of RunTHDone -> return () _ -> loopTH --- | Forwards a @Message@ call, and handle @SlaveMessage@. --- Similar to @THMessages@, but @SlaveMessage@ are between --- the slave and the proxy, and are not forwarded to ghc. --- These message allow the Slave to query the proxy for +-- | Forwards a @Message@ call, and handle @ProxyMessage@. +-- Similar to @THMessages@, but @ProxyMessage@ are between +-- the interpreter and the proxy, and are not forwarded to ghc. +-- These message allow the interpreter to query the proxy for -- files. -- --- ghc --- proxy --> slave (@Message@) +-- ghc --- proxy --> interpreter (@Message@) -- --- proxy <-- slave (@SlaveMessage@) +-- proxy <-- interpreter (@ProxyMessage@) -- fwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a fwdLoadCall verbose _ remote msg = do @@ -194,15 +194,15 @@ fwdLoadCall verbose _ remote msg = do reply :: (Binary a, Show a) => a -> IO () reply m = do when verbose $ - trace ("| Resp.: proxy -> slave: " + trace ("| Resp.: proxy -> interpreter: " ++ truncateMsg 80 (show m)) writePipe remote (put m) loopLoad :: IO () loopLoad = do when verbose $ trace "fwdLoadCall: reading remote pipe" - SlaveMsg msg' <- readPipe remote getSlaveMessage + SomeProxyMessage msg' <- readPipe remote getProxyMessage when verbose $ - trace ("| Sl Msg: proxy <- slave: " ++ show msg') + trace ("| Sl Msg: proxy <- interpreter: " ++ show msg') case msg' of Done -> return () Missing path -> do @@ -233,18 +233,18 @@ proxy verbose local remote = loop reply :: (Show a, Binary a) => a -> IO () reply msg = do when verbose $ - trace ("Resp.: ghc <- proxy -- slave: " ++ show msg) + trace ("Resp.: ghc <- proxy -- interpreter: " ++ show msg) writePipe local (put msg) loop = do (Msg msg) <- readPipe local getMessage when verbose $ - trace ("Msg: ghc -- proxy -> slave: " ++ show msg) + trace ("Msg: ghc -- proxy -> interpreter: " ++ show msg) (Msg msg') <- hook (Msg msg) -- Note [proxy-communication] -- -- The fwdTHCall/fwdLoadCall/fwdCall's have to match up - -- with their endpoints in libiserv:IServ.Remote.Slave otherwise + -- with their endpoints in libiserv:IServ.Remote.Interpreter otherwise -- you will end up with hung connections. -- -- We are intercepting some calls between ghc and iserv diff --git a/iserv-proxy.cabal b/iserv-proxy.cabal index 7bf12c8..792463f 100644 --- a/iserv-proxy.cabal +++ b/iserv-proxy.cabal @@ -21,33 +21,36 @@ Description: -fproxy@ will yield the proxy. . Using the cabal for the target @arch-platform-target-cabal install - -flibrary@ will build the required library that contains the ffi - @startSlave@ function, which needs to be invoked on the target - (e.g. in an iOS application) to start the remote iserv slave. + -flibrary@ will build the required library that contains the FFI + @startInterpreter@ function, which needs to be invoked on the target + (e.g. in an iOS application) to start the remote iserv interpreter . calling the GHC cross compiler with @-fexternal-interpreter -pgmi=$HOME/.cabal/bin/iserv-proxy -opti\<ip address\> -opti\<port\>@ will cause it to compile Template Haskell via the remote at \<ip address\>. . Thus to get cross compilation with Template Haskell follow the - following receipt: + following recipe: . * compile the iserv library for your target . > iserv $ arch-platform-target-cabal install -flibrary . * setup an application for your target that calls the - * startSlave function. This could be either haskell or your - * targets ffi capable language, if needed. + @startInterpreter@ function. This could be either Haskell or your + target's FFI-capable language, if needed. . - > void startSlave(false /* verbose */, 5000 /* port */, - > "/path/to/storagelocation/on/target"); + > void startInterpreter( + > false /* verbose */, 5000 /* port */, + > "/path/to/storagelocation/on/target"); . - * build the iserv-proxy + * build the @iserv-proxy@ . > iserv $ cabal install -flibrary -fproxy - * Start your iserv-slave app on your target running on say @10.0.0.1:5000@ - * compiler your sources with -fexternal-interpreter and the proxy + . + * Start your iserv interpreter app on your target running on, for instance, + @10.0.0.1:5000@. Compile your sources with @-fexternal-interpreter@ and the + proxy . > project $ arch-platform-target-ghc ModuleContainingTH.hs \ > -fexternal-interpreter \ @@ -66,7 +69,7 @@ Library Hs-Source-Dirs: src Exposed-Modules: IServ.Remote.Message, - IServ.Remote.Slave + IServ.Remote.Interpreter Build-Depends: array >= 0.5 && < 0.6, base >= 4 && < 5, binary >= 0.7 && < 0.9, diff --git a/src/IServ/Remote/Slave.hs b/src/IServ/Remote/Interpreter.hs similarity index 85% rename from src/IServ/Remote/Slave.hs rename to src/IServ/Remote/Interpreter.hs index 54998f6..f481d8c 100644 --- a/src/IServ/Remote/Slave.hs +++ b/src/IServ/Remote/Interpreter.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface, GADTs, LambdaCase #-} -module IServ.Remote.Slave where +module IServ.Remote.Interpreter where import Network.Socket @@ -41,23 +41,23 @@ dropLeadingPathSeparator p | isAbsolute p = joinPath (drop 1 (splitPath p)) lhs <//> rhs = dropTrailingPathSeparator lhs </> dropLeadingPathSeparator rhs infixr 5 <//> -foreign export ccall startSlave :: Bool -> Int -> CString -> IO () +foreign export ccall startInterpreter :: Bool -> Int -> CString -> IO () --- | @startSlave@ is the exported slave function, that the --- hosting application on the target needs to invoce to --- start the slave process, and runs iserv. -startSlave :: Bool -> Int -> CString -> IO () -startSlave verbose port s = do +-- | @startInterpreter@ is the exported interpreter function, that the +-- hosting application on the target needs to invoke to +-- start the interpreter process, and runs iserv. +startInterpreter :: Bool -> Int -> CString -> IO () +startInterpreter verbose port s = do base_path <- peekCString s trace $ "DocRoot: " ++ base_path - _ <- forkIO $ startSlave' verbose base_path (toEnum port) + _ <- forkIO $ startInterpreter' verbose base_path (toEnum port) return () --- | @startSlave'@ provdes a blocking haskell interface, that +-- | @startInterpreter'@ provdes a blocking haskell interface, that -- the hosting application on the target can use to start the --- slave process. -startSlave' :: Bool -> String -> PortNumber -> IO () -startSlave' verbose base_path port = do +-- interpreter process. +startInterpreter' :: Bool -> String -> PortNumber -> IO () +startInterpreter' verbose base_path port = do hSetBuffering stdin LineBuffering hSetBuffering stdout LineBuffering @@ -85,9 +85,9 @@ startSlave' verbose base_path port = do return () -- | The iserv library may need access to files, specifically --- archives and object files to be linked. If ghc and the slave +-- archives and object files to be linked. If ghc and the interpreter -- are on the same host, this is trivial, as the underlying --- filestorage is the same. If however the slave does not run +-- filestorage is the same. If, however, the interpreter does not run -- on the same host, the filestorage is not identical and we -- need to request data from the host where ghc runs on. -- @@ -112,9 +112,9 @@ handleLoad pipe path localPath = do proxyCall Done where - proxyCall :: (Binary a, Show a) => SlaveMessage a -> IO a + proxyCall :: (Binary a, Show a) => ProxyMessage a -> IO a proxyCall msg = do - writePipe pipe (putSlaveMessage msg) + writePipe pipe (putProxyMessage msg) readPipe pipe get -- | The hook we install in the @serv@ function from the diff --git a/src/IServ/Remote/Message.hs b/src/IServ/Remote/Message.hs index 7475a7a..29b7bc3 100644 --- a/src/IServ/Remote/Message.hs +++ b/src/IServ/Remote/Message.hs @@ -1,38 +1,39 @@ {-# LANGUAGE GADTs, StandaloneDeriving, ExistentialQuantification #-} module IServ.Remote.Message - ( SlaveMessage(..) - , SlaveMsg(..) - , putSlaveMessage - , getSlaveMessage ) + ( ProxyMessage(..) + , SomeProxyMessage(..) + , putProxyMessage + , getProxyMessage ) where import GHC.Fingerprint (Fingerprint) import Data.Binary import Data.ByteString (ByteString) --- | A @SlaveMessage a@ is message from the iserv process on the +-- | A @ProxyMessage a@ is message from the iserv process on the -- target, requesting something from the Proxy of with result type @a@. -data SlaveMessage a where +data ProxyMessage a where -- sends either a new file, or nothing if the file is acceptable. - Have :: FilePath -> Fingerprint -> SlaveMessage (Maybe ByteString) - Missing :: FilePath -> SlaveMessage ByteString - Done :: SlaveMessage () + Have :: FilePath -> Fingerprint -> ProxyMessage (Maybe ByteString) + Missing :: FilePath -> ProxyMessage ByteString + Done :: ProxyMessage () -deriving instance Show (SlaveMessage a) +deriving instance Show (ProxyMessage a) -putSlaveMessage :: SlaveMessage a -> Put -putSlaveMessage m = case m of +putProxyMessage :: ProxyMessage a -> Put +putProxyMessage m = case m of Have path sha -> putWord8 0 >> put path >> put sha Missing path -> putWord8 1 >> put path Done -> putWord8 2 -data SlaveMsg = forall a . (Binary a, Show a) => SlaveMsg (SlaveMessage a) +data SomeProxyMessage where + SomeProxyMessage :: forall a. (Binary a, Show a) => ProxyMessage a -> SomeProxyMessage -getSlaveMessage :: Get SlaveMsg -getSlaveMessage = do +getProxyMessage :: Get SomeProxyMessage +getProxyMessage = do b <- getWord8 case b of - 0 -> SlaveMsg <$> (Have <$> get <*> get) - 1 -> SlaveMsg <$> Missing <$> get - 2 -> return (SlaveMsg Done) + 0 -> SomeProxyMessage <$> (Have <$> get <*> get) + 1 -> SomeProxyMessage <$> Missing <$> get + 2 -> return (SomeProxyMessage Done) -- GitLab