-- Test code for "threadWait: invalid argument (Bad file descriptor)"
-- See https://ghc.haskell.org/trac/ghc/ticket/14621
-- See https://github.com/haskell/network/issues/287
--
-- % runghc BadFileDescriptor.hs
-- BadFileDescriptor.hs: threadWait: invalid argument (Bad file descriptor)
module Main where

import Control.Concurrent (forkIO)
import Control.Monad (forever, void)
import Network.Socket hiding (recv)
import Network.Socket.ByteString (recv, sendAll)

main :: IO ()
main = do
    let localhost = "localhost"
        listenPort = "9876"
        connectPort = "6789"
    proxy localhost listenPort connectPort

proxy :: HostName -> ServiceName -> ServiceName -> IO ()
proxy localhost listenPort connectPort = do
    fromClient <- serverSocket localhost listenPort
    toServer <- clientSocket localhost connectPort
    void $ forkIO $ relay toServer fromClient
    relay fromClient toServer

relay :: Socket -> Socket -> IO ()
relay s1 s2 = forever $ do
    payload <- recv s1 4096
    sendAll s2 payload

serverSocket :: HostName -> ServiceName -> IO Socket
serverSocket host port = do
    let hints =
            defaultHints
                { addrFlags = [AI_PASSIVE]
                , addrSocketType = Stream
                }
    addr : _ <- getAddrInfo (Just hints) (Just host) (Just port)
    sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
    bind sock (addrAddress addr)
    listen sock 1
    fst <$> accept sock

clientSocket :: HostName -> ServiceName -> IO Socket
clientSocket host port = do
    let hints = defaultHints{addrSocketType = Stream}
    addr : _ <- getAddrInfo (Just hints) (Just host) (Just port)
    sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
    connect sock (addrAddress addr)
    return sock
