Refactor to modularize more

Former-commit-id: 1d5ae90a514e575706d5a4ed333cb7bcea613fed
Former-commit-id: 9cfc1936086198e0c437346608794694e0e95b90 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly c66b2faff45e0b65779d7fed4d3355d859ae8e34]]]]
Former-commit-id: 4d38d80a6e1bd03be92f0939f269803676094da4
Former-commit-id: ad7ee33491764b8111037c046f64b5c288cfe420
Former-commit-id: 7089db6838c542c2a278992e492a421303b20707
Former-commit-id: 00f00a4f5296725498aeb0daa8b21cfa4568627e [formerly fd688a2c91cc9c927fd8fa32f7e62dc432286d86]
Former-commit-id: 991bfe5b8f959fad26e326877e92f168127f0803

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

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-----"

src/Logger.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Utils where
+module Logger where
 
 import           ClassyPrelude
 import           Network.Socket    (HostName, PortNumber)

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
+import           Logger
-deriving instance Hashable PortNumber
+import qualified Socks5
-deriving instance Generic N.SockAddr
+import           Types
-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)
 
 
 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

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)
+import           Logger
-
+import qualified Credentials
-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
-  }
-
-
-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 ()
+  where
-runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do
+    debugPP msg = debug $ "====\n" <> msg <> "\n===="
-  debug $ "Starting socks5 proxy " <> show socksSettings
 
-  N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do
+myTry :: MonadError Error m => IO a -> IO (m ())
-    -- Get the auth request and response with a no Auth
+myTry f = either (\(e :: SomeException) -> throwError . Other $ show e) (const $ return ()) <$> try f
-    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
 
+(<==>) :: 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)

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)

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