module Devel.ReverseProxy
( startReverseProxy
, createSocket
, createSocketSafe
, checkPort
, cyclePorts
) where
import Network.HTTP.ReverseProxy (WaiProxyResponse(WPRProxyDest), ProxyDest(ProxyDest), waiProxyTo)
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.HTTP.Types (status200)
import Network.Wai.Handler.Warp (run)
import Control.Exception
import Network.Socket
import Data.Streaming.Network (bindPortTCP)
import Network.Wai (Application, responseLBS)
import Data.IORef
import Text.Hamlet
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
startReverseProxy :: (Int, Int) -> IORef [String] -> IO ()
startReverseProxy (fromProxyPort, toProxyPort) iStrLst = do
mgr <- newManager defaultManagerSettings
let onException' :: SomeException -> Application
onException' _ _ respond =do
lstt <- readIORef iStrLst
respond $ responseLBS status200
[ ("content-type", "text/html")
, ("Refresh", "1")
]
(renderHtml $(shamletFile "build.hamlet"))
proxyApp = waiProxyTo
(\_ -> return $ WPRProxyDest $ ProxyDest "0.0.0.0" toProxyPort)
onException'
mgr
run fromProxyPort proxyApp
createSocketSafe :: Int -> IO (Socket, Int)
createSocketSafe port' = do
port <- cyclePorts port'
sock <- createSocket port
return (sock, port)
createSocket :: Int -> IO Socket
createSocket port = do
sock <- bindPortTCP port "*4"
setSocketOption sock ReuseAddr 1
return sock
checkPort :: Int -> IO Bool
checkPort port = do
es <- try $ bindPortTCP port "*4"
case es of
Left (_ :: IOException) -> return False
Right s -> do
sClose s
return True
cyclePorts :: Int -> IO Int
cyclePorts p = do
let port = p + 1
portAvailable <- checkPort port
case portAvailable of
True -> return port
_ -> cyclePorts port