simple Haskell TCP proxy

haskellTcpProxy.hs

module TcpProxy where
  
import Control.Concurrent      (forkIO)
import Control.Monad           (forever, unless, void)
import Network                 (PortID(PortNumber),listenOn)
import Network.Socket hiding (listen,recv,send)
import Network.Socket.ByteString (recv,sendAll)
import qualified Data.ByteString as S
import System.Posix            (Handler(Ignore),installHandler,sigPIPE)
import Control.Exception        (finally)
import Control.Concurrent.Async (race_)

data Setting = Setting { locPort :: PortNumber , remHost :: String, remPort :: String }

setting :: Setting
setting = Setting 9900 "ftp.free.fr" "80"

main :: IO ()
main = installHandler sigPIPE Ignore Nothing >> do
  (servAddr:_) <- getAddrInfo Nothing (Just $ remHost setting) (Just $ remPort setting)
  withSocketsDo $ do
    listener <- listenOn $ PortNumber (locPort setting)
    forever $ accept listener >>= \(client,_) -> 
        void $ forkIO $ do 
        server <- getServerSocket servAddr
        client <~~> server
  where
    getServerSocket servAddr = do
      server <- socket (addrFamily servAddr) Stream defaultProtocol
      connect server (addrAddress servAddr) >> return server
    p1 <~~> p2      = finally (race_ (p1 `mapData` p2) (p2 `mapData` p1)) (close p1 >> close p2)
    mapData from to = do
      content <- recv from 4096 
      unless (S.null content) $ sendAll to content >> mapData from to

Fix threadWait error

Apply async patterns

https://mazzo.li/posts/threads-resources.html