iserv: Remove network dependent parts of libiserv

As noted in #20794 the parts of libiserv and iserv-proxy depend on
network, therefore are never built nor tested during CI.

Due to this iserv-proxy had bitrotted due to the bound on bytestring
being out of date.

Given we don't test this code it seems undesirable to distribute it.
Therefore, it's removed and an external maintainer can be responsible
for testing it (via head.hackage if desired).

Fixes #20794

4 files changed, 0 insertions, 464 deletions

diff --git a/libraries/libiserv/libiserv.cabal.in b/libraries/libiserv/libiserv.cabal.in
index 8e2a43fcfd..708f10c143 100644
--- a/libraries/libiserv/libiserv.cabal.in
+++ b/libraries/libiserv/libiserv.cabal.in
@@ -30,12 +30,6 @@ Library
                    containers >= 0.5 && < 0.7,
                    deepseq    >= 1.4 && < 1.5,
                    ghci       == @ProjectVersionMunged@
-    if flag(network)
-       Exposed-Modules: Remote.Message
-                      , Remote.Slave
-       Build-Depends: network    >= 2.6 && < 3,
-                      directory  >= 1.3 && < 1.4,
-                      filepath   >= 1.4 && < 1.5
 
     if os(windows)
        Cpp-Options: -DWINDOWS
diff --git a/libraries/libiserv/proxy-src/Remote.hs b/libraries/libiserv/proxy-src/Remote.hs
deleted file mode 100644
index d07220ba7f..0000000000
--- a/libraries/libiserv/proxy-src/Remote.hs
+++ /dev/null
@@ -1,263 +0,0 @@
-{-# 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 GHC.Fingerprint (getFileHash)
-import System.Directory
-import System.FilePath (isAbsolute)
-
-import Data.Binary
-import qualified Data.ByteString as BS
-
-dieWithUsage :: IO a
-dieWithUsage = do
-    prog <- getProgName
-    die $ prog ++ ": " ++ msg
-  where
-#if defined(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
-
-  when verbose $
-    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 <- getFileHash 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
-        LoadDLL path | isAbsolute path -> 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/libraries/libiserv/src/Remote/Message.hs b/libraries/libiserv/src/Remote/Message.hs
deleted file mode 100644
index f1745301ba..0000000000
--- a/libraries/libiserv/src/Remote/Message.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-{-# LANGUAGE GADTs, StandaloneDeriving, ExistentialQuantification #-}
-
-module Remote.Message
-  ( SlaveMessage(..)
-  , SlaveMsg(..)
-  , putSlaveMessage
-  , getSlaveMessage )
-where
-
-import GHC.Fingerprint (Fingerprint)
-import Data.Binary
-import Data.ByteString (ByteString)
-
--- | 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 -> Fingerprint -> 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/libraries/libiserv/src/Remote/Slave.hs b/libraries/libiserv/src/Remote/Slave.hs
deleted file mode 100644
index 4c150becfa..0000000000
--- a/libraries/libiserv/src/Remote/Slave.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# 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, (</>), dropTrailingPathSeparator,
-                        isAbsolute, joinPath, splitPath)
-import GHCi.ResolvedBCO
-
-import Data.IORef
-import GHCi.Message (Pipe(..), Msg(..), Message(..), readPipe, writePipe)
-
-import Foreign.C.String
-
-import Data.Binary
-import GHC.Fingerprint (getFileHash)
-
-import qualified Data.ByteString as BS
-
-import Text.Printf
-import System.Environment (getProgName)
-
-trace :: String -> IO ()
-trace s = getProgName >>= \name -> printf "[%20s] %s\n" name s
-
-dropLeadingPathSeparator :: FilePath -> FilePath
-dropLeadingPathSeparator p | isAbsolute p = joinPath (drop 1 (splitPath p))
-                           | otherwise    = p
-
--- | Path concatenation that prevents a double path separator to appear in the
--- final path. "/foo/bar/" <//> "/baz/quux" == "/foo/bar/baz/quux"
-(<//>) :: FilePath -> FilePath -> FilePath
-lhs <//> rhs = dropTrailingPathSeparator lhs </> dropLeadingPathSeparator rhs
-infixr 5 <//>
-
-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
-  base_path <- peekCString s
-  trace $ "DocRoot: " ++ base_path
-  _ <- forkIO $ startSlave' verbose base_path (toEnum port)
-  return ()
-
--- | @startSlave'@ 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
-  hSetBuffering stdin LineBuffering
-  hSetBuffering stdout LineBuffering
-
-  sock <- openSocket port
-  actualPort <- socketPort sock
-  putStrLn $ "Listening on port " ++ show actualPort
-
-  forever $ do
-    when verbose $ trace "Opening socket"
-    pipe <- acceptSocket sock >>= socketToPipe
-    when verbose $ trace "Starting serv"
-    uninterruptibleMask $ serv verbose (hook verbose base_path pipe) pipe
-    when verbose $ trace "serv ended"
-    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 Fingerprint 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 Fingerprint, 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 getFileHash 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
-    when verbose $ putStrLn ("Need Obj: " ++ (base_path <//> path))
-    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))
-  -- when loading DLLs (.so, .dylib, .dll, ...) and these are provided
-  -- as relative paths, the intention is to load a pre-existing system library,
-  -- therefore we hook the LoadDLL call only for absolute paths to ship the
-  -- dll from the host to the target.  On windows we assume that we don't
-  -- want to copy libraries that are referenced in C:\ these are usually
-  -- system libraries.
-  Msg (LoadDLL path@('C':':':_)) -> do
-    return m
-  Msg (LoadDLL path) | isAbsolute path -> do
-    when verbose $ trace ("Need DLL: " ++ (base_path <//> path))
-    handleLoad 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