Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Really terrible HTTP CONNECT proxy for Haskell/WAI
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
import Control.Exception (finally)
import Control.Monad
import Control.Monad.Trans (liftIO)
import Data.ByteString.Char8 ()
import qualified Data.ByteString as B
import Data.Monoid
import Network.HTTP.Types
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai as Wai
import Data.Conduit as C
import qualified Data.Conduit.Network as DCN
proxy :: Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
proxy request respond = do
putStrLn $ "Received: " ++ show request
case Wai.requestMethod request of
"CONNECT" -> do
let hostAndPortInfo = Wai.rawPathInfo request
-- TODO: parse hostname and port from the above...
let failure = Wai.responseLBS status500 [] "Upgrade failure"
upgrade = Wai.responseRaw $ \ input output -> do
complete <- newEmptyMVar
let fini = void $ putMVar complete ()
-- TODO: return 5xx if runTCPClient fails
void . DCN.runTCPClient (DCN.clientSettings 443 "google.com") $ \ appData -> do
output "HTTP/1.1 200 Connection Established\r\nProxy-agent: Mega Proxy\r\n\r\n"
forkIO $ do
let source =
forever $ do
input' <- liftIO input
when (not $ B.null input') $ yield input'
finally
(runConduit $ source $$ DCN.appSink appData)
fini
forkIO $ do
let sink = do
await >>= \ case
Just inp -> liftIO (output inp) >> sink
Nothing -> return ()
finally
(runConduit $ DCN.appSource appData $$ sink)
fini
takeMVar complete -- once for the source
takeMVar complete -- and one for the sink
respond $ upgrade failure
_ -> error "blah blah blah"
main :: IO ()
main = do
Warp.run 3030 proxy
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.