Refactor HTTP Proxy code

Former-commit-id: 276c9b224a2a7e8d3eb7c906e0f2346896dd0987
Former-commit-id: 6e243437da37a6301c0959f1a449572a96f96bcf [formerly b56151dc14bea8a86bf672047bbbb9cf8486b4db [formerly b56151dc14bea8a86bf672047bbbb9cf8486b4db [formerly b56151dc14bea8a86bf672047bbbb9cf8486b4db [formerly b5b717b1fa6bb2e1b9b893a5f8495011085a13a9]]]]
Former-commit-id: fd939ef892ec61d3781e8094d6801187fa15febf
Former-commit-id: 908ed7b0f78f80d26b8887885088d6c0dfd9d99a
Former-commit-id: 4cb284f918770412de20382c1b834e174dd4e304
Former-commit-id: 4dc0d2c8313c793387116f118c318087389538e3 [formerly 3daca73d2b9f52ad8c3396c01086f41292a94158]
Former-commit-id: 64736efbae1a6f444b38cbc2c803d755c2fadde8

src/HttpProxy.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE StrictData            #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module HttpProxy () where
+
+
+
+import           ClassyPrelude
+import qualified Data.ByteString.Char8     as BC
+
+import           Control.Monad.Except
+import qualified Data.Conduit.Network.TLS  as N
+import qualified Data.Streaming.Network    as N
+import           System.Timeout
+
+import qualified Data.ByteString.Base64    as B64
+import           Network.Socket            (HostName, PortNumber)
+import qualified Network.Socket            as N hiding (recv, recvFrom, send,
+                                                 sendTo)
+import qualified Network.Socket.ByteString as N
+
+import           Logger
+import           Types
+
+
+data HttpProxySettings = HttpProxySettings
+  { proxyHost   :: HostName
+  , proxyPort   :: PortNumber
+  , credentials :: Maybe (ByteString, ByteString)
+  } deriving (Show)
+
+
+httpProxyConnection :: MonadError Error m => HttpProxySettings -> (HostName, PortNumber) ->  (Connection -> IO (m a)) -> IO (m a)
+httpProxyConnection HttpProxySettings{..} (host, port) app = onError $ do
+  debug $ "Oppening tcp connection to proxy " <> show proxyHost <> ":" <> show proxyPort
+
+  ret <- N.runTCPClient (N.clientSettingsTCP (fromIntegral proxyPort) (fromString proxyHost)) $ \conn' -> do
+    let conn = toConnection conn'
+    _ <- sendConnectRequest conn
+
+    -- wait 10sec for a reply before giving up
+    let _10sec = 1000000 * 10
+    responseM <- timeout _10sec $ readConnectResponse mempty conn
+
+    case responseM of
+      Just (isAuthorized -> True) -> app conn
+      Just response               -> return . throwError $ ProxyForwardError (BC.unpack response)
+      Nothing                     -> return . throwError $ ProxyForwardError ("No response from the proxy after "
+                                                                              <> show (_10sec `div` 1000000) <> "sec" )
+
+  debug $ "Closing tcp connection to proxy " <> show proxyHost <> ":" <> show proxyPort
+  return ret
+
+  where
+    credentialsToHeader :: (ByteString, ByteString) -> ByteString
+    credentialsToHeader (user, password) = "Proxy-Authorization: Basic " <> B64.encode (user <> ":" <> password) <> "\r\n"
+
+    sendConnectRequest :: Connection -> IO ()
+    sendConnectRequest h = write h $ "CONNECT " <> fromString host <> ":" <> fromString (show port) <> " HTTP/1.0\r\n"
+                                  <> "Host: " <> fromString host <> ":" <> (fromString $ show port) <> "\r\n"
+                                  <> maybe mempty credentialsToHeader credentials
+                                  <> "\r\n"
+
+    readConnectResponse :: ByteString -> Connection -> IO ByteString
+    readConnectResponse buff conn = do
+      responseM <- read conn
+      case responseM of
+        Nothing       -> return buff
+        Just response -> if "\r\n\r\n" `isInfixOf` response
+                          then return $ buff <> response
+                          else readConnectResponse (buff <> response) conn
+
+    isAuthorized :: ByteString -> Bool
+    isAuthorized response = " 200 " `isInfixOf` response
+
+    onError f = catch f $ \(e :: SomeException) -> return $
+      if (take 10 (show e) == "user error")
+        then throwError $ ProxyConnectionError (show e)
+        else throwError $ ProxyConnectionError ("Unknown Error :: " <> show e)

wstunnel.cabal

@@ -15,7 +15,7 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Tunnel, Protocols, Types, Logger, Socks5, Credentials
+  exposed-modules:     Tunnel, Protocols, Types, Logger, Socks5, Credentials, HttpProxy
   default-extensions:  NoImplicitPrelude, ScopedTypeVariables, BangPatterns, RecordWildCards
   build-depends:       async
                      , base