Enter iserv-proxy

With the introduction of -fexternal-interpreter we are
now able to compile template haskell via an extern iserv process.

This however is restricted to the same host, and can therefore
not be used with crosscompilers where the iserv slave process
needs to run on a different machine than the cross compiling
haskell compiler.

This diff breaks up iserv into a library and the iserv-bin binary.
It also introduces the iserv-proxy, a proxy instance that the
haskell compiler can talk to, and which forwards the calls
to the iserv slave on a different machine, as well as providing
some extra functionarily (sending files that are not available
on the machine the slave runs on), as well as forwarding from
the slave to the haskell compiler, when the slave needs to
interrogate the haskell compiler.

The iserv library now also exports the startSlave function to be
called by the application that implements the slave on the target.

The simplest such app would probably look something like:

```
extern void startServ(bool, const char *);

int main(int argc, char * argv[]) {
  hs_init(NULL, NULL);
  startServ(false,"/tmp");
  while(1);
}
```

Special thanks to Shea Levy for the first draft of the iserv-remote,
from which I took some inspiration.

The `Buildable` flags are due to ghc-cabal not being able to build
more than a single target.  Please note that only the stock iserv-bin
is supposed to be built *with* ghc.  The library and proxy are supposed
to be built outside of ghc.  Yet I believe that this code should live
together with iserv.

Reviewers: simonmar, ezyang, goldfire, austin, rwbarton, bgamari

Reviewed By: simonmar

Subscribers: luite, ryantrinkle, shlevy, thomie

Differential Revision: https://phabricator.haskell.org/D3233

6 files changed, 615 insertions, 66 deletions

diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal
index 5307e7fc0e..f0abf54901 100644
--- a/iserv/iserv-bin.cabal
+++ b/iserv/iserv-bin.cabal
@@ -5,19 +5,108 @@ License: BSD3
 -- XXX License-File: LICENSE
 Author: XXX
 Maintainer: XXX
-Synopsis: XXX
+Synopsis: iserv allows GHC to delegate Tempalte Haskell computations
 Description:
-        XXX
+  GHC can be provided with a path to the iserv binary with
+  @-pgmi=/path/to/iserv-bin@, and will in combination with
+  @-fexternal-interpreter@, compile Template Haskell though the
+  @iserv-bin@ delegate. This is very similar to how ghcjs has been
+  compiling Template Haskell, by spawning a separate delegate (so
+  called runner on the javascript vm) and evaluating the splices
+  there.
+  .
+  iserv can also be used in combination with cross compilation. For
+  this, the @iserv-proxy@ needs to be built on the host, targeting the
+  host (as it is running on the host). @cabal install -flibrary
+  -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.
+  .
+  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:
+  .
+  * 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.
+  .
+      >  void startSlave(false /* verbose */, 5000 /* port */,
+      >                  "/path/to/storagelocation/on/target");
+  .
+  * 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
+  .
+      > project $ arch-platform-target-ghc ModuleContainingTH.hs \
+      >             -fexternal-interpreter \
+      >             -pgmi=$HOME/.cabal/bin/iserv-proxy \
+      >             -opti10.0.0.1 -opti5000
+  .
+  Should something not work as expected, provide @-opti-v@ for verbose
+  logging of the @iserv-proxy@.
+
 Category: Development
 build-type: Simple
 cabal-version: >=1.10
 
+Flag library
+    Description:   Build iserv library
+    Default:       False
+
+Flag proxy
+    Description:   Build iserv-proxy
+    Default:       False
+
+Library
+    If flag(library)
+       Buildable: True
+    Else
+       Buildable: False
+    Default-Language: Haskell2010
+    Hs-Source-Dirs: src
+    Exposed-Modules: Lib
+                   , Remote.Message
+                   , Remote.Slave
+                   , GHCi.Utils
+    Build-Depends: base       >= 4   && < 5,
+                   binary     >= 0.7 && < 0.9,
+                   bytestring >= 0.10 && < 0.11,
+                   containers >= 0.5 && < 0.6,
+                   deepseq    >= 1.4 && < 1.5,
+                   cryptonite >= 0.22,
+                   ghci       == 8.1,
+                   network    >= 2.6 && < 2.7,
+                   directory  >= 1.3 && < 1.4,
+                   filepath   >= 1.4 && < 1.5
+   if os(windows)
+       Cpp-Options: -DWINDOWS
+   else
+       Build-Depends: unix   >= 2.7 && < 2.8
+
 Executable iserv
     Default-Language: Haskell2010
+    ghc-options: -no-hs-main
     Main-Is: Main.hs
     C-Sources: cbits/iservmain.c
     Hs-Source-Dirs: src
-    Other-Modules: GHCi.Utils
+    include-dirs: .
+    If flag(library)
+       Other-Modules: GHCi.Utils
+    Else
+       Other-Modules: GHCi.Utils
+                    , Lib
     Build-Depends: array      >= 0.5 && < 0.6,
                    base       >= 4   && < 5,
                    binary     >= 0.7 && < 0.9,
@@ -30,3 +119,21 @@ Executable iserv
         Cpp-Options: -DWINDOWS
     else
         Build-Depends: unix   >= 2.7 && < 2.8
+
+Executable iserv-proxy
+   If flag(proxy)
+      Buildable: True
+   Else
+      Buildable: False
+   Default-Language: Haskell2010
+   Main-Is: Remote.hs
+   Hs-Source-Dirs: proxy-src
+   Build-Depends: array      >= 0.5 && < 0.6,
+                  base       >= 4   && < 5,
+                  binary     >= 0.7 && < 0.9,
+                  bytestring >= 0.10 && < 0.11,
+                  containers >= 0.5 && < 0.6,
+                  deepseq    >= 1.4 && < 1.5,
+                  ghci       == 8.1,
+                  network    >= 2.6,
+                  iserv-bin
diff --git a/iserv/proxy-src/Remote.hs b/iserv/proxy-src/Remote.hs
new file mode 100644
index 0000000000..6b1d528e18
--- /dev/null
+++ b/iserv/proxy-src/Remote.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE CPP, GADTs, OverloadedStrings #-}
+
+{-
+This is the proxy portion of iserv.
+
+It acts as local bridge for GHC to call
+a remote slave. 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
+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,
+no proxy is needed. GHC and iserv communicate
+via pipes.
+
+iserv-proxy is the proxy instance to iserv.
+The following illustration should make this
+somewhat clear:
+
+ .----- Host -----.     .- Target -.
+ | GHC <--> proxy<+-----+>  iserv  |
+ '----------------'  ^  '----------'
+        ^            |
+        |            '-- communication via sockets
+        '--- communication via pipes
+
+For now, we won't support multiple concurrent
+invocations of the proxy instance, and that
+behavior will be undefined, as this largely
+depends on the capability of the iserv on the
+target to spawn multiple process.  Spawning
+multiple threads won't be sufficient, as the
+GHC runtime has global state.
+
+Also the GHC runtime needs to be able to
+use the linker on the Target to link archives
+and object files.
+
+-}
+
+module Main (main) where
+
+import System.IO
+import GHCi.Message
+import GHCi.Utils
+import GHCi.Signals
+
+import Remote.Message
+
+import Network.Socket
+import Data.IORef
+import Control.Monad
+import System.Environment
+import System.Exit
+import Text.Printf
+
+import Data.Binary
+import qualified Data.ByteString as BS
+
+dieWithUsage :: IO a
+dieWithUsage = do
+    prog <- getProgName
+    die $ prog ++ ": " ++ msg
+  where
+#ifdef WINDOWS
+    msg = "usage: iserv <write-handle> <read-handle> <slave ip> [-v]"
+#else
+    msg = "usage: iserv <write-fd> <read-fd> <slave ip> [-v]"
+#endif
+
+main :: IO ()
+main = do
+  args <- getArgs
+  (wfd1, rfd2, host_ip, port, rest) <-
+      case args of
+        arg0:arg1:arg2:arg3:rest -> do
+            let wfd1 = read arg0
+                rfd2 = read arg1
+                ip   = arg2
+                port = read arg3
+            return (wfd1, rfd2, ip, port, rest)
+        _ -> dieWithUsage
+
+  verbose <- case rest of
+    ["-v"] -> return True
+    []     -> return False
+    _      -> dieWithUsage
+
+  when verbose $
+    printf "GHC iserv starting (in: %d; out: %d)\n"
+      (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
+  inh  <- getGhcHandle rfd2
+  outh <- getGhcHandle wfd1
+  installSignalHandlers
+  lo_ref <- newIORef Nothing
+  let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}
+
+  when verbose $
+    putStrLn ("Trying to connect to " ++ host_ip ++ ":" ++ (show port))
+  out_pipe <- connectTo host_ip port >>= socketToPipe
+
+  putStrLn "Starting proxy"
+  proxy verbose in_pipe out_pipe
+
+-- | A hook, to transform outgoing (proxy -> slave)
+-- messages prior to sending them to the slave.
+hook :: Msg -> IO Msg
+hook = return
+
+-- | Forward a single @THMessage@ from the slave
+-- 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@)
+--
+fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a
+fwdTHMsg local msg = do
+  writePipe local (putTHMessage msg)
+  readPipe local get
+
+-- | Fowarard a @Message@ call and handle @THMessages@.
+fwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a
+fwdTHCall verbose local remote msg = do
+  writePipe remote (putMessage msg)
+  -- wait for control instructions
+  loopTH
+  readPipe remote get
+    where
+      loopTH :: IO ()
+      loopTH = do
+        THMsg msg' <- readPipe remote getTHMessage
+        when verbose $
+          putStrLn ("| TH Msg: ghc <- proxy -- slave: " ++ show msg')
+        res <- fwdTHMsg local msg'
+        when verbose $
+          putStrLn ("| Resp.:  ghc -- proxy -> slave: " ++ 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
+-- files.
+--
+--  ghc --- proxy --> slave  (@Message@)
+--
+--          proxy <-- slave  (@SlaveMessage@)
+--
+fwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a
+fwdLoadCall verbose _ remote msg = do
+  writePipe remote (putMessage msg)
+  loopLoad
+  readPipe remote get
+  where
+    truncateMsg :: Int -> String -> String
+    truncateMsg n s | length s > n = take n s ++ "..."
+                    | otherwise    = s
+    reply :: (Binary a, Show a) => a -> IO ()
+    reply m = do
+      when verbose $
+        putStrLn ("| Resp.:         proxy -> slave: "
+                  ++ truncateMsg 80 (show m))
+      writePipe remote (put m)
+    loopLoad :: IO ()
+    loopLoad = do
+      SlaveMsg msg' <- readPipe remote getSlaveMessage
+      when verbose $
+        putStrLn ("| Sl Msg:        proxy <- slave: " ++ show msg')
+      case msg' of
+        Done -> return ()
+        Missing path -> do
+          reply =<< BS.readFile path
+          loopLoad
+        Have path remoteHash -> do
+          localHash <- sha256sum path
+          reply =<< if localHash == remoteHash
+                    then return Nothing
+                    else Just <$> BS.readFile path
+          loopLoad
+
+-- | The actual proxy. Conntect local and remote pipe,
+-- and does some message handling.
+proxy :: Bool -> Pipe -> Pipe -> IO ()
+proxy verbose local remote = loop
+  where
+    fwdCall :: (Binary a, Show a) => Message a -> IO a
+    fwdCall msg = do
+      writePipe remote (putMessage msg)
+      readPipe remote get
+
+    -- reply to ghc.
+    reply :: (Show a, Binary a) => a -> IO ()
+    reply msg = do
+      when verbose $
+        putStrLn ("Resp.:    ghc <- proxy -- slave: " ++ show msg)
+      writePipe local (put msg)
+
+    loop = do
+      (Msg msg) <- readPipe local getMessage
+      when verbose $
+        putStrLn ("Msg:      ghc -- proxy -> slave: " ++ show msg)
+      (Msg msg') <- hook (Msg msg)
+      case msg' of
+        -- TH might send some message back to ghc.
+        RunTH{} -> do
+          resp <- fwdTHCall verbose local remote msg'
+          reply resp
+          loop
+        RunModFinalizers{} -> do
+          resp <- fwdTHCall verbose local remote msg'
+          reply resp
+          loop
+        -- Load messages might send some messages back to the proxy, to
+        -- requrest files that are not present on the device.
+        LoadArchive{} -> do
+          resp <- fwdLoadCall verbose local remote msg'
+          reply resp
+          loop
+        LoadObj{} -> do
+          resp <- fwdLoadCall verbose local remote msg'
+          reply resp
+          loop
+        Shutdown{}    -> fwdCall msg' >> return ()
+        _other        -> fwdCall msg' >>= reply >> loop
+
+
+connectTo :: String -> PortNumber -> IO Socket
+connectTo host port = do
+  let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV]
+                           , addrSocketType = Stream }
+  addr:_ <- getAddrInfo (Just hints) (Just host) (Just (show port))
+  sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+  putStrLn $ "Created socket for " ++ host ++ ":" ++ show port
+  connect sock (addrAddress addr)
+  putStrLn "connected"
+  return sock
+
+-- | Turn a socket into an unbuffered pipe.
+socketToPipe :: Socket -> IO Pipe
+socketToPipe sock = do
+  hdl <- socketToHandle sock ReadWriteMode
+  hSetBuffering hdl NoBuffering
+
+  lo_ref <- newIORef Nothing
+  pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }
diff --git a/iserv/src/Lib.hs b/iserv/src/Lib.hs
new file mode 100644
index 0000000000..57e65706c3
--- /dev/null
+++ b/iserv/src/Lib.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE RankNTypes, RecordWildCards, GADTs, ScopedTypeVariables #-}
+module Lib (serv) where
+
+import GHCi.Run
+import GHCi.TH
+import GHCi.Message
+
+import Control.DeepSeq
+import Control.Exception
+import Control.Monad
+import Data.Binary
+
+type MessageHook = Msg -> IO Msg
+
+serv :: Bool -> MessageHook -> Pipe -> (forall a .IO a -> IO a) -> IO ()
+serv verbose hook pipe@Pipe{..} restore = loop
+ where
+  loop = do
+    Msg msg <- readPipe pipe getMessage >>= hook
+    discardCtrlC
+
+    when verbose $ putStrLn ("iserv: " ++ show msg)
+    case msg of
+      Shutdown -> return ()
+      RunTH st q ty loc -> wrapRunTH $ runTH pipe st q ty loc
+      RunModFinalizers st qrefs -> wrapRunTH $ runModFinalizerRefs pipe st qrefs
+      _other -> run msg >>= reply
+
+  reply :: forall a. (Binary a, Show a) => a -> IO ()
+  reply r = do
+    when verbose $ putStrLn ("iserv: return: " ++ show r)
+    writePipe pipe (put r)
+    loop
+
+  -- Run some TH code, which may interact with GHC by sending
+  -- THMessage requests, and then finally send RunTHDone followed by a
+  -- QResult.  For an overview of how TH works with Remote GHCi, see
+  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.
+  wrapRunTH :: forall a. (Binary a, Show a) => IO a -> IO ()
+  wrapRunTH io = do
+    r <- try io
+    writePipe pipe (putTHMessage RunTHDone)
+    case r of
+      Left e
+        | Just (GHCiQException _ err) <- fromException e  ->
+           reply (QFail err :: QResult a)
+        | otherwise -> do
+           str <- showException e
+           reply (QException str :: QResult a)
+      Right a -> do
+        when verbose $ putStrLn "iserv: QDone"
+        reply (QDone a)
+
+  -- carefully when showing an exception, there might be other exceptions
+  -- lurking inside it.  If so, we return the inner exception instead.
+  showException :: SomeException -> IO String
+  showException e0 = do
+     r <- try $ evaluate (force (show (e0::SomeException)))
+     case r of
+       Left e -> showException e
+       Right str -> return str
+
+  -- throw away any pending ^C exceptions while we're not running
+  -- interpreted code.  GHC will also get the ^C, and either ignore it
+  -- (if this is GHCi), or tell us to quit with a Shutdown message.
+  discardCtrlC = do
+    r <- try $ restore $ return ()
+    case r of
+      Left UserInterrupt -> return () >> discardCtrlC
+      Left e -> throwIO e
+      _ -> return ()
diff --git a/iserv/src/Main.hs b/iserv/src/Main.hs
index 8c76e1fe71..858cee8e94 100644
--- a/iserv/src/Main.hs
+++ b/iserv/src/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, RecordWildCards, GADTs, ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE CPP, GADTs #-}
 
 -- |
 -- The Remote GHCi server.
@@ -8,16 +8,14 @@
 --
 module Main (main) where
 
-import GHCi.Run
-import GHCi.TH
+import Lib (serv)
+
 import GHCi.Message
 import GHCi.Signals
 import GHCi.Utils
 
-import Control.DeepSeq
 import Control.Exception
 import Control.Monad
-import Data.Binary
 import Data.IORef
 import System.Environment
 import System.Exit
@@ -49,7 +47,7 @@ main = do
     ["-v"] -> return True
     []     -> return False
     _      -> dieWithUsage
-  when verbose $ do
+  when verbose $
     printf "GHC iserv starting (in: %d; out: %d)\n"
       (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
   inh  <- getGhcHandle rfd2
@@ -57,63 +55,9 @@ main = do
   installSignalHandlers
   lo_ref <- newIORef Nothing
   let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}
-  uninterruptibleMask $ serv verbose pipe
+  uninterruptibleMask $ serv verbose hook pipe
+
+  where hook = return -- empty hook
     -- we cannot allow any async exceptions while communicating, because
     -- we will lose sync in the protocol, hence uninterruptibleMask.
 
-serv :: Bool -> Pipe -> (forall a .IO a -> IO a) -> IO ()
-serv verbose pipe@Pipe{..} restore = loop
- where
-  loop = do
-    Msg msg <- readPipe pipe getMessage
-    discardCtrlC
-    when verbose $ putStrLn ("iserv: " ++ show msg)
-    case msg of
-      Shutdown -> return ()
-      RunTH st q ty loc -> wrapRunTH $ runTH pipe st q ty loc
-      RunModFinalizers st qrefs -> wrapRunTH $ runModFinalizerRefs pipe st qrefs
-      _other -> run msg >>= reply
-
-  reply :: forall a. (Binary a, Show a) => a -> IO ()
-  reply r = do
-    when verbose $ putStrLn ("iserv: return: " ++ show r)
-    writePipe pipe (put r)
-    loop
-
-  -- Run some TH code, which may interact with GHC by sending
-  -- THMessage requests, and then finally send RunTHDone followed by a
-  -- QResult.  For an overview of how TH works with Remote GHCi, see
-  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.
-  wrapRunTH :: forall a. (Binary a, Show a) => IO a -> IO ()
-  wrapRunTH io = do
-    r <- try io
-    writePipe pipe (putTHMessage RunTHDone)
-    case r of
-      Left e
-        | Just (GHCiQException _ err) <- fromException e  -> do
-           reply (QFail err :: QResult a)
-        | otherwise -> do
-           str <- showException e
-           reply (QException str :: QResult a)
-      Right a -> do
-        when verbose $ putStrLn "iserv: QDone"
-        reply (QDone a)
-
-  -- carefully when showing an exception, there might be other exceptions
-  -- lurking inside it.  If so, we return the inner exception instead.
-  showException :: SomeException -> IO String
-  showException e0 = do
-     r <- try $ evaluate (force (show (e0::SomeException)))
-     case r of
-       Left e -> showException e
-       Right str -> return str
-
-  -- throw away any pending ^C exceptions while we're not running
-  -- interpreted code.  GHC will also get the ^C, and either ignore it
-  -- (if this is GHCi), or tell us to quit with a Shutdown message.
-  discardCtrlC = do
-    r <- try $ restore $ return ()
-    case r of
-      Left UserInterrupt -> return () >> discardCtrlC
-      Left e -> throwIO e
-      _ -> return ()
diff --git a/iserv/src/Remote/Message.hs b/iserv/src/Remote/Message.hs
new file mode 100644
index 0000000000..faef45dcab
--- /dev/null
+++ b/iserv/src/Remote/Message.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE GADTs, StandaloneDeriving, ExistentialQuantification #-}
+
+module Remote.Message
+  ( SlaveMessage(..)
+  , SlaveMsg(..)
+  , sha256sum
+  , putSlaveMessage
+  , getSlaveMessage )
+where
+
+import Data.Binary
+import Data.ByteString as BS (ByteString, readFile)
+
+import Crypto.Hash
+
+type Sha256Hash = String
+
+sha256 :: ByteString -> Digest SHA256
+sha256 = hash
+
+sha256sum :: FilePath -> IO Sha256Hash
+sha256sum path = (show . sha256) <$> BS.readFile path
+
+-- | A @SlaveMessage a@ is message from the iserv process on the
+-- target, requesting something from the Proxy of with result type @a@.
+data SlaveMessage a where
+  -- sends either a new file, or nothing if the file is acceptable.
+  Have     :: FilePath -> Sha256Hash -> SlaveMessage (Maybe ByteString)
+  Missing  :: FilePath -> SlaveMessage ByteString
+  Done     :: SlaveMessage ()
+
+deriving instance Show (SlaveMessage a)
+
+putSlaveMessage :: SlaveMessage a -> Put
+putSlaveMessage 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)
+
+getSlaveMessage :: Get SlaveMsg
+getSlaveMessage = do
+  b <- getWord8
+  case b of
+    0 -> SlaveMsg <$> (Have   <$> get <*> get)
+    1 -> SlaveMsg <$> Missing <$> get
+    2 -> return (SlaveMsg Done)
diff --git a/iserv/src/Remote/Slave.hs b/iserv/src/Remote/Slave.hs
new file mode 100644
index 0000000000..2d47a346c6
--- /dev/null
+++ b/iserv/src/Remote/Slave.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE ForeignFunctionInterface, GADTs, LambdaCase #-}
+module Remote.Slave where
+
+import Network.Socket
+
+import Lib (serv)
+import Remote.Message
+
+import System.IO
+import Control.Exception
+import Control.Concurrent
+import Control.Monad (when, forever)
+import System.Directory
+import System.FilePath (takeDirectory)
+
+import Data.IORef
+import GHCi.Message (Pipe(..), Msg(..), Message(..), readPipe, writePipe)
+
+import Foreign.C.String
+
+import Data.Binary
+
+import qualified Data.ByteString as BS
+
+foreign export ccall startSlave :: 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
+  putStr "DocRoot: "
+  base_path <- peekCString s
+  putStrLn base_path
+  startSlave' verbose base_path (toEnum port)
+
+startSlave' :: Bool -> String -> PortNumber -> IO ()
+startSlave' verbose base_path port = do
+
+  sock <- openSocket port
+
+  _ <- forkIO $ forever $ do
+    when verbose $ putStrLn "Opening socket"
+    pipe <- acceptSocket sock >>= socketToPipe
+    putStrLn $ "Listening on port " ++ show port
+    when verbose $ putStrLn "Staring serv"
+    uninterruptibleMask $ serv verbose (hook verbose base_path pipe) pipe
+    when verbose $ putStrLn "serv ended"
+    return ()
+
+  return ()
+
+-- | The iserv library may need access to files, specifically
+-- archives and object files to be linked. If ghc and the slave
+-- are on the same host, this is trivial, as the underlying
+-- filestorage is the same.  If however the slave 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.
+--
+-- If we however already have the requested file we need to make
+-- sure that this file is the same one ghc sees. Hence we
+-- calculate the sha256sum of the file and send it back to the
+-- host for comparison. The proxy will then send back either @Nothing@
+-- indicating that the file on the host has the same sha256sum, or
+-- Maybe ByteString containing the payload to replace the existing
+-- file with.
+handleLoad :: Pipe -> FilePath -> FilePath -> IO ()
+handleLoad pipe path localPath = do
+  exists <- doesFileExist localPath
+  if exists
+    then sha256sum localPath >>= \hash -> proxyCall (Have path hash) >>= \case
+      Nothing -> return ()
+      Just bs -> BS.writeFile localPath bs
+    else do
+      createDirectoryIfMissing True (takeDirectory localPath)
+      resp <- proxyCall (Missing path)
+      BS.writeFile localPath resp
+
+  proxyCall Done
+  where
+    proxyCall :: (Binary a, Show a) => SlaveMessage a -> IO a
+    proxyCall msg = do
+      writePipe pipe (putSlaveMessage msg)
+      readPipe pipe get
+
+-- | The hook we install in the @serv@ function from the
+-- iserv library, to request archives over the wire.
+hook :: Bool -> String -> Pipe -> Msg -> IO Msg
+hook verbose base_path pipe m = case m of
+  Msg (AddLibrarySearchPath p) -> do
+    when verbose $ putStrLn ("Need Path: " ++ base_path ++ p)
+    createDirectoryIfMissing True (base_path ++ p)
+    return $ Msg (AddLibrarySearchPath (base_path ++ p))
+  Msg (LoadObj path) -> do
+    handleLoad pipe path (base_path ++ path)
+    return $ Msg (LoadObj (base_path ++ path))
+  Msg (LoadArchive path) -> do
+    handleLoad pipe path (base_path ++ path)
+    return $ Msg (LoadArchive (base_path ++ path))
+  -- Msg (LoadDLL path) -> do
+  --   handleLoad ctl_pipe path (base_path ++ path)
+  --   return $ Msg (LoadDLL (base_path ++ path))
+  _other -> return m
+
+--------------------------------------------------------------------------------
+-- socket to pipe briding logic.
+socketToPipe :: Socket -> IO Pipe
+socketToPipe sock = do
+  hdl <- socketToHandle sock ReadWriteMode
+  hSetBuffering hdl NoBuffering
+
+  lo_ref <- newIORef Nothing
+  pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }
+
+openSocket :: PortNumber -> IO Socket
+openSocket port = do
+  sock <- socket AF_INET Stream 0
+  setSocketOption sock ReuseAddr 1
+  bind sock (SockAddrInet port iNADDR_ANY)
+  listen sock 1
+  return sock
+
+acceptSocket :: Socket -> IO Socket
+acceptSocket = fmap fst . accept