1-- Test code for "threadWait: invalid argument (Bad file descriptor)" 2-- See https://ghc.haskell.org/trac/ghc/ticket/14621 3-- See https://github.com/haskell/network/issues/287 4-- 5-- % runghc BadFileDescriptor.hs 6-- BadFileDescriptor.hs: threadWait: invalid argument (Bad file descriptor) 7module Main where 8 9import Control.Concurrent (forkIO) 10import Control.Monad (void, forever) 11import Network.Socket hiding (recv) 12import Network.Socket.ByteString (recv, sendAll) 13 14main :: IO () 15main = do 16 let localhost = "localhost" 17 listenPort = "9876" 18 connectPort = "6789" 19 proxy localhost listenPort connectPort 20 21proxy :: HostName -> ServiceName -> ServiceName -> IO () 22proxy localhost listenPort connectPort = do 23 fromClient <- serverSocket localhost listenPort 24 toServer <- clientSocket localhost connectPort 25 void $ forkIO $ relay toServer fromClient 26 relay fromClient toServer 27 28relay :: Socket -> Socket -> IO () 29relay s1 s2 = forever $ do 30 payload <- recv s1 4096 31 sendAll s2 payload 32 33serverSocket :: HostName -> ServiceName -> IO Socket 34serverSocket host port = do 35 let hints = defaultHints { 36 addrFlags = [AI_PASSIVE] 37 , addrSocketType = Stream 38 } 39 addr:_ <- getAddrInfo (Just hints) (Just host) (Just port) 40 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 41 bind sock (addrAddress addr) 42 listen sock 1 43 fst <$> accept sock 44 45clientSocket :: HostName -> ServiceName -> IO Socket 46clientSocket host port = do 47 let hints = defaultHints { addrSocketType = Stream } 48 addr:_ <- getAddrInfo (Just hints) (Just host) (Just port) 49 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 50 connect sock (addrAddress addr) 51 return sock 52