diff --git a/app/Main.hs b/app/Main.hs index 77d9660..9c54475 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,7 +4,6 @@ module Main where -import Tunnel import ClassyPrelude (ByteString, guard, readMay) import qualified Data.ByteString.Char8 as BC @@ -13,6 +12,9 @@ import System.Console.CmdArgs import System.Environment (getArgs, withArgs) import qualified System.Log.Logger as LOG +import Tunnel +import Types + data WsTunnel = WsTunnel { localToRemote :: String -- , remoteToLocal :: String @@ -135,12 +137,12 @@ main = do else if not $ null (localToRemote cfg) then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg) in runClient TunnelSettings { localBind = lHost - , Tunnel.localPort = fromIntegral lPort + , Types.localPort = fromIntegral lPort , serverHost = Main.host serverInfo , serverPort = fromIntegral $ Main.port serverInfo , destHost = rHost , destPort = fromIntegral rPort - , Tunnel.useTls = Main.useTls serverInfo + , Types.useTls = Main.useTls serverInfo , protocol = if udpMode cfg then UDP else TCP , proxySetting = parseProxyInfo (proxy cfg) , useSocks = False @@ -148,12 +150,12 @@ main = do else if not $ null (dynamicToRemote cfg) then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212" in runClient TunnelSettings { localBind = lHost - , Tunnel.localPort = fromIntegral lPort + , Types.localPort = fromIntegral lPort , serverHost = Main.host serverInfo , serverPort = fromIntegral $ Main.port serverInfo , destHost = "" , destPort = 0 - , Tunnel.useTls = Main.useTls serverInfo + , Types.useTls = Main.useTls serverInfo , protocol = SOCKS5 , proxySetting = parseProxyInfo (proxy cfg) , useSocks = True diff --git a/src/Credentials.hs b/src/Credentials.hs new file mode 100644 index 0000000..d5ba8fe --- /dev/null +++ b/src/Credentials.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Credentials where + +import ClassyPrelude + +-- openssl genrsa 512 > host.key +-- openssl req -new -x509 -nodes -sha1 -days 9999 -key host.key > host.cert +key :: ByteString +key = "-----BEGIN RSA PRIVATE KEY-----\n" <> + "MIIBOgIBAAJBAMEEloIcF3sTGYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5k\n" <> + "Uew8CR58e7c5GgK08ZOJwi2Hpl9MfDm4mGUCAwEAAQJAGP+nHqLUx7PpkqYd8iVX\n" <> + "iQB/nfqEhRnF27GDZTb9RT7e3bR7X1B9oIBnpmqwMG5oPxidoIKv+jzZjsQcxKLu\n" <> + "4QIhAPdcPmFrtLUpTXx21wtVxotsO7+YcQxtRtBoXeiREUInAiEAx8Jx9a6eVRIh\n" <> + "slSTJMPuy/LbvK8VUTqtx9x2EhFhBJMCIQC68qlmwZs6y/N3HO4b8AD1gKCLhm/y\n" <> + "P2ikvCw1R+ZuQwIgdfcgMUPzgK16dMN5OabzaEF8/kouvo92fKZ2m2jj8D0CIFY8\n" <> + "4SkXDkpeUEKKfxHqrEkkxmpRk93Ui1NPyN+wxrgO\n" <> + "-----END RSA PRIVATE KEY-----" + +certificate :: ByteString +certificate = "-----BEGIN CERTIFICATE-----\n" <> + "MIICXTCCAgegAwIBAgIJAJf1Sm7DI0KcMA0GCSqGSIb3DQEBBQUAMIGJMQswCQYD\n" <> + "VQQGEwJGUjESMBAGA1UECAwJQXF1aXRhaW5lMRAwDgYDVQQHDAdCYXlvbm5lMQ4w\n" <> + "DAYDVQQKDAVFcmViZTELMAkGA1UECwwCSVQxFjAUBgNVBAMMDXJvbWFpbi5nZXJh\n" <> + "cmQxHzAdBgkqhkiG9w0BCQEWEHdoeW5vdEBnbWFpbC5jb20wHhcNMTYwNTIxMTUy\n" <> + "MzIyWhcNNDMxMDA2MTUyMzIyWjCBiTELMAkGA1UEBhMCRlIxEjAQBgNVBAgMCUFx\n" <> + "dWl0YWluZTEQMA4GA1UEBwwHQmF5b25uZTEOMAwGA1UECgwFRXJlYmUxCzAJBgNV\n" <> + "BAsMAklUMRYwFAYDVQQDDA1yb21haW4uZ2VyYXJkMR8wHQYJKoZIhvcNAQkBFhB3\n" <> + "aHlub3RAZ21haWwuY29tMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAMEEloIcF3sT\n" <> + "GYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5kUew8CR58e7c5GgK08ZOJwi2H\n" <> + "pl9MfDm4mGUCAwEAAaNQME4wHQYDVR0OBBYEFLY0HsQst1t3QRXU0aTWg3V1IvGX\n" <> + "MB8GA1UdIwQYMBaAFLY0HsQst1t3QRXU0aTWg3V1IvGXMAwGA1UdEwQFMAMBAf8w\n" <> + "DQYJKoZIhvcNAQEFBQADQQCP4oYOIrX7xvmQih3hvF4kUnbKjtttImdGruonsLAz\n" <> + "OL2VExC6OqlDP2yu14BlsjTt+X2v6mhHnSM16c6AkpM/\n" <> + "-----END CERTIFICATE-----" diff --git a/src/Utils.hs b/src/Logger.hs similarity index 95% rename from src/Utils.hs rename to src/Logger.hs index 1691050..c597e64 100644 --- a/src/Utils.hs +++ b/src/Logger.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Utils where +module Logger where import ClassyPrelude import Network.Socket (HostName, PortNumber) diff --git a/src/Protocols.hs b/src/Protocols.hs index 366201e..72464dc 100644 --- a/src/Protocols.hs +++ b/src/Protocols.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} module Protocols where @@ -22,25 +20,11 @@ import qualified Network.Socket as N hiding (recv, recvFrom, send, sendTo) import qualified Network.Socket.ByteString as N -import Utils +import Data.Binary (decode, encode) -deriving instance Generic PortNumber -deriving instance Hashable PortNumber -deriving instance Generic N.SockAddr -deriving instance Hashable N.SockAddr - -data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq) - -data UdpAppData = UdpAppData - { appAddr :: N.SockAddr - , appSem :: MVar ByteString - , appRead :: IO ByteString - , appWrite :: ByteString -> IO () - } - -instance N.HasReadWrite UdpAppData where - readLens f appData = fmap (\getData -> appData { appRead = getData}) (f $ appRead appData) - writeLens f appData = fmap (\writeData -> appData { appWrite = writeData}) (f $ appWrite appData) +import Logger +import qualified Socks5 +import Types runTCPServer :: (HostName, PortNumber) -> (N.AppData -> IO ()) -> IO () @@ -108,3 +92,26 @@ runUDPServer endPoint@(host, port) app = do (addNewClient clientsCtx socket addr payload) (removeClient clientsCtx) (void . timeout (30 * 10^(6 :: Int)) . app) + + +runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO () +runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do + info $ "Starting socks5 proxy " <> show socksSettings + + N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do + -- Get the auth request and response with a no Auth + authRequest <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.ResponseAuth + debug $ "Socks5 authentification request " <> show authRequest + let responseAuth = encode $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth + N.appWrite cnx (toStrict responseAuth) + + -- Get the request and update dynamically the tunnel config + request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request + debug $ "Socks5 forward request " <> show request + let responseRequest = encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request) + let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request } + N.appWrite cnx (toStrict responseRequest) + + inner cfg' cnx + + info $ "Closing socks5 proxy " <> show socksSettings diff --git a/src/Tunnel.hs b/src/Tunnel.hs index e1e9089..2b67add 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -9,9 +9,6 @@ module Tunnel ( runClient , runServer - , TunnelSettings(..) - , Protocol(..) - , ProxySettings(..) ) where import ClassyPrelude @@ -34,93 +31,18 @@ import qualified Network.WebSockets.Stream as WS import Control.Monad.Except import qualified Network.Connection as NC -import Protocols import System.IO (IOMode (ReadWriteMode)) import System.Timeout import qualified Data.ByteString.Base64 as B64 -import Utils +import Types +import Protocols import qualified Socks5 -import Data.Binary (encode, decode) - -data ProxySettings = ProxySettings - { host :: HostName - , port :: PortNumber - , credentials :: Maybe (ByteString, ByteString) - } deriving (Show) - -data TunnelSettings = TunnelSettings - { proxySetting :: Maybe ProxySettings - , localBind :: HostName - , localPort :: PortNumber - , serverHost :: HostName - , serverPort :: PortNumber - , destHost :: HostName - , destPort :: PortNumber - , protocol :: Protocol - , useTls :: Bool - , useSocks :: Bool - } - -instance Show TunnelSettings where - show TunnelSettings{..} = localBind <> ":" <> show localPort - <> (if isNothing proxySetting - then mempty - else " <==PROXY==> " <> host (fromJust proxySetting) <> ":" <> (show . port $ fromJust proxySetting) - ) - <> " <==" <> (if useTls then "WSS" else "WS") <> "==> " - <> serverHost <> ":" <> show serverPort - <> " <==" <> show (if protocol == SOCKS5 then TCP else protocol) <> "==> " <> destHost <> ":" <> show destPort +import Logger +import qualified Credentials -data Connection = Connection - { read :: IO (Maybe ByteString) - , write :: ByteString -> IO () - , close :: IO () - , rawConnection :: Maybe N.Socket - } - - -data Error = ProxyConnectionError String - | ProxyForwardError String - | LocalServerError String - | TunnelError String - | WebsocketError String - | TlsError String - | Other String - deriving (Show) - -class ToConnection a where - toConnection :: a -> Connection - -instance ToConnection WS.Connection where - toConnection conn = Connection { read = Just <$> WS.receiveData conn - , write = WS.sendBinaryData conn - , close = WS.sendClose conn (mempty :: LByteString) - , rawConnection = Nothing - } - -instance ToConnection N.AppData where - toConnection conn = Connection { read = Just <$> N.appRead conn - , write = N.appWrite conn - , close = N.appCloseConnection conn - , rawConnection = Nothing - } - -instance ToConnection UdpAppData where - toConnection conn = Connection { read = Just <$> appRead conn - , write = appWrite conn - , close = return () - , rawConnection = Nothing - } - -instance ToConnection NC.Connection where - toConnection conn = Connection { read = Just <$> NC.connectionGetChunk conn - , write = NC.connectionPut conn - , close = NC.connectionClose conn - , rawConnection = Nothing - } rrunTCPClient :: N.ClientSettings -> (Connection -> IO a) -> IO a rrunTCPClient cfg app = bracket @@ -252,49 +174,18 @@ runClient cfg@TunnelSettings{..} = do TCP -> runTCPServer (localBind, localPort) (app cfg) SOCKS5 -> runSocks5Server (Socks5.ServerSettings localPort localBind) cfg app -handleError :: Either Error () -> IO () -handleError (Right ()) = return () -handleError (Left errMsg) = - case errMsg of - ProxyConnectionError msg -> err "Cannot connect to the proxy" >> debugPP msg - ProxyForwardError msg -> err "Connection not allowed by the proxy" >> debugPP msg - TunnelError msg -> err "Cannot establish the connection to the server" >> debugPP msg - LocalServerError msg -> err "Cannot create the localServer, port already binded ?" >> debugPP msg - WebsocketError msg -> err "Cannot establish websocket connection with the server" >> debugPP msg - TlsError msg -> err "Cannot do tls handshake with the server" >> debugPP msg - Other msg -> debugPP msg - - where - debugPP msg = debug $ "====\n" <> msg <> "\n====" -(<==>) :: Connection -> Connection -> IO (Either Error ()) -(<==>) hTunnel hOther = - myTry $ race_ (propagateReads hTunnel hOther) (propagateWrites hTunnel hOther) - -propagateReads :: Connection -> Connection -> IO () -propagateReads hTunnel hOther = forever $ read hTunnel >>= write hOther . fromJust - - -propagateWrites :: Connection -> Connection -> IO () -propagateWrites hTunnel hOther = do - payload <- fromJust <$> read hOther - unless (null payload) (write hTunnel payload >> propagateWrites hTunnel hOther) - - -myTry :: MonadError Error m => IO a -> IO (m ()) -myTry f = either (\(e :: SomeException) -> throwError . Other $ show e) (const $ return ()) <$> try f -- -- Server -- - runTlsTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () runTlsTunnelingServer endPoint@(bindTo, portNumber) isAllowed = do info $ "WAIT for TLS connection on " <> toStr endPoint - N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) serverCertificate serverKey) $ \sClient -> + N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) Credentials.certificate Credentials.key) $ \sClient -> runApp sClient WS.defaultConnectionOptions (serverEventLoop isAllowed) info "SHUTDOWN server" @@ -344,43 +235,9 @@ runServer useTLS = if useTLS then runTlsTunnelingServer else runTunnelingServer --- openssl genrsa 512 > host.key --- openssl req -new -x509 -nodes -sha1 -days 9999 -key host.key > host.cert -serverKey :: ByteString -serverKey = "-----BEGIN RSA PRIVATE KEY-----\n" <> - "MIIBOgIBAAJBAMEEloIcF3sTGYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5k\n" <> - "Uew8CR58e7c5GgK08ZOJwi2Hpl9MfDm4mGUCAwEAAQJAGP+nHqLUx7PpkqYd8iVX\n" <> - "iQB/nfqEhRnF27GDZTb9RT7e3bR7X1B9oIBnpmqwMG5oPxidoIKv+jzZjsQcxKLu\n" <> - "4QIhAPdcPmFrtLUpTXx21wtVxotsO7+YcQxtRtBoXeiREUInAiEAx8Jx9a6eVRIh\n" <> - "slSTJMPuy/LbvK8VUTqtx9x2EhFhBJMCIQC68qlmwZs6y/N3HO4b8AD1gKCLhm/y\n" <> - "P2ikvCw1R+ZuQwIgdfcgMUPzgK16dMN5OabzaEF8/kouvo92fKZ2m2jj8D0CIFY8\n" <> - "4SkXDkpeUEKKfxHqrEkkxmpRk93Ui1NPyN+wxrgO\n" <> - "-----END RSA PRIVATE KEY-----" - -serverCertificate :: ByteString -serverCertificate = "-----BEGIN CERTIFICATE-----\n" <> - "MIICXTCCAgegAwIBAgIJAJf1Sm7DI0KcMA0GCSqGSIb3DQEBBQUAMIGJMQswCQYD\n" <> - "VQQGEwJGUjESMBAGA1UECAwJQXF1aXRhaW5lMRAwDgYDVQQHDAdCYXlvbm5lMQ4w\n" <> - "DAYDVQQKDAVFcmViZTELMAkGA1UECwwCSVQxFjAUBgNVBAMMDXJvbWFpbi5nZXJh\n" <> - "cmQxHzAdBgkqhkiG9w0BCQEWEHdoeW5vdEBnbWFpbC5jb20wHhcNMTYwNTIxMTUy\n" <> - "MzIyWhcNNDMxMDA2MTUyMzIyWjCBiTELMAkGA1UEBhMCRlIxEjAQBgNVBAgMCUFx\n" <> - "dWl0YWluZTEQMA4GA1UEBwwHQmF5b25uZTEOMAwGA1UECgwFRXJlYmUxCzAJBgNV\n" <> - "BAsMAklUMRYwFAYDVQQDDA1yb21haW4uZ2VyYXJkMR8wHQYJKoZIhvcNAQkBFhB3\n" <> - "aHlub3RAZ21haWwuY29tMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAMEEloIcF3sT\n" <> - "GYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5kUew8CR58e7c5GgK08ZOJwi2H\n" <> - "pl9MfDm4mGUCAwEAAaNQME4wHQYDVR0OBBYEFLY0HsQst1t3QRXU0aTWg3V1IvGX\n" <> - "MB8GA1UdIwQYMBaAFLY0HsQst1t3QRXU0aTWg3V1IvGXMAwGA1UdEwQFMAMBAf8w\n" <> - "DQYJKoZIhvcNAQEFBQADQQCP4oYOIrX7xvmQih3hvF4kUnbKjtttImdGruonsLAz\n" <> - "OL2VExC6OqlDP2yu14BlsjTt+X2v6mhHnSM16c6AkpM/\n" <> - "-----END CERTIFICATE-----" - - - -- -- Commons -- - - toPath :: TunnelSettings -> String toPath TunnelSettings{..} = "/" <> toLower (show $ if protocol == SOCKS5 then TCP else protocol) <> "/" <> destHost <> "/" <> show destPort @@ -393,29 +250,33 @@ fromPath path = let rets = BC.split '/' . BC.drop 1 $ path proto <- readMay . toUpper . BC.unpack $ protocol :: Maybe Protocol return (proto, h, prt') +handleError :: Either Error () -> IO () +handleError (Right ()) = return () +handleError (Left errMsg) = + case errMsg of + ProxyConnectionError msg -> err "Cannot connect to the proxy" >> debugPP msg + ProxyForwardError msg -> err "Connection not allowed by the proxy" >> debugPP msg + TunnelError msg -> err "Cannot establish the connection to the server" >> debugPP msg + LocalServerError msg -> err "Cannot create the localServer, port already binded ?" >> debugPP msg + WebsocketError msg -> err "Cannot establish websocket connection with the server" >> debugPP msg + TlsError msg -> err "Cannot do tls handshake with the server" >> debugPP msg + Other msg -> debugPP msg -runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO () -runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do - debug $ "Starting socks5 proxy " <> show socksSettings + where + debugPP msg = debug $ "====\n" <> msg <> "\n====" - N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do - -- Get the auth request and response with a no Auth - authRequest <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.ResponseAuth - debug $ "Socks5 authentification request " <> show authRequest - let responseAuth = encode $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth - N.appWrite cnx (toStrict responseAuth) - - -- Get the request and update dynamically the tunnel config - request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request - debug $ "Socks5 forward request " <> show request - let responseRequest = encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request) - let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request } - N.appWrite cnx (toStrict responseRequest) - - inner cfg' cnx - - debug $ "Closing socks5 proxy " <> show socksSettings +myTry :: MonadError Error m => IO a -> IO (m ()) +myTry f = either (\(e :: SomeException) -> throwError . Other $ show e) (const $ return ()) <$> try f +(<==>) :: Connection -> Connection -> IO (Either Error ()) +(<==>) hTunnel hOther = + myTry $ race_ (propagateReads hTunnel hOther) (propagateWrites hTunnel hOther) +propagateReads :: Connection -> Connection -> IO () +propagateReads hTunnel hOther = forever $ read hTunnel >>= write hOther . fromJust +propagateWrites :: Connection -> Connection -> IO () +propagateWrites hTunnel hOther = do + payload <- fromJust <$> read hOther + unless (null payload) (write hTunnel payload >> propagateWrites hTunnel hOther) diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..19b83e9 --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} + + +module Types where + +import ClassyPrelude +import Data.Maybe + +import qualified Data.Streaming.Network as N +import qualified Network.Connection as NC +import Network.Socket (HostName, PortNumber) +import qualified Network.Socket as N hiding (recv, recvFrom, + send, sendTo) +import qualified Network.Socket.ByteString as N + +import qualified Network.WebSockets.Connection as WS + +deriving instance Generic PortNumber +deriving instance Hashable PortNumber +deriving instance Generic N.SockAddr +deriving instance Hashable N.SockAddr + + +data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq) + +data UdpAppData = UdpAppData + { appAddr :: N.SockAddr + , appSem :: MVar ByteString + , appRead :: IO ByteString + , appWrite :: ByteString -> IO () + } + +instance N.HasReadWrite UdpAppData where + readLens f appData = fmap (\getData -> appData { appRead = getData}) (f $ appRead appData) + writeLens f appData = fmap (\writeData -> appData { appWrite = writeData}) (f $ appWrite appData) + +data ProxySettings = ProxySettings + { host :: HostName + , port :: PortNumber + , credentials :: Maybe (ByteString, ByteString) + } deriving (Show) + +data TunnelSettings = TunnelSettings + { proxySetting :: Maybe ProxySettings + , localBind :: HostName + , localPort :: PortNumber + , serverHost :: HostName + , serverPort :: PortNumber + , destHost :: HostName + , destPort :: PortNumber + , protocol :: Protocol + , useTls :: Bool + , useSocks :: Bool + } + +instance Show TunnelSettings where + show TunnelSettings{..} = localBind <> ":" <> show localPort + <> (if isNothing proxySetting + then mempty + else " <==PROXY==> " <> host (fromJust proxySetting) <> ":" <> (show . port $ fromJust proxySetting) + ) + <> " <==" <> (if useTls then "WSS" else "WS") <> "==> " + <> serverHost <> ":" <> show serverPort + <> " <==" <> show (if protocol == SOCKS5 then TCP else protocol) <> "==> " <> destHost <> ":" <> show destPort + + +data Connection = Connection + { read :: IO (Maybe ByteString) + , write :: ByteString -> IO () + , close :: IO () + , rawConnection :: Maybe N.Socket + } + +class ToConnection a where + toConnection :: a -> Connection + +instance ToConnection WS.Connection where + toConnection conn = Connection { read = Just <$> WS.receiveData conn + , write = WS.sendBinaryData conn + , close = WS.sendClose conn (mempty :: LByteString) + , rawConnection = Nothing + } + +instance ToConnection N.AppData where + toConnection conn = Connection { read = Just <$> N.appRead conn + , write = N.appWrite conn + , close = N.appCloseConnection conn + , rawConnection = Nothing + } + +instance ToConnection UdpAppData where + toConnection conn = Connection { read = Just <$> appRead conn + , write = appWrite conn + , close = return () + , rawConnection = Nothing + } + +instance ToConnection NC.Connection where + toConnection conn = Connection { read = Just <$> NC.connectionGetChunk conn + , write = NC.connectionPut conn + , close = NC.connectionClose conn + , rawConnection = Nothing + } + +data Error = ProxyConnectionError String + | ProxyForwardError String + | LocalServerError String + | TunnelError String + | WebsocketError String + | TlsError String + | Other String + deriving (Show) diff --git a/wstunnel.cabal b/wstunnel.cabal index 3dcef3d..8f43db9 100644 --- a/wstunnel.cabal +++ b/wstunnel.cabal @@ -15,7 +15,7 @@ cabal-version: >=1.10 library hs-source-dirs: src - exposed-modules: Tunnel, Protocols, Utils, Socks5 + exposed-modules: Tunnel, Protocols, Types, Logger, Socks5, Credentials build-depends: async , base , base64-bytestring >= 1.0