wstunnel-0.4.1.0: test/Spec.hs

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE OverloadedStrings  #-}

import           ClassyPrelude          hiding (getArgs, head)
import qualified Logger
import qualified Network.Socket                as N hiding (recv, recvFrom,
                                                     send, sendTo)
import qualified Network.Socket.ByteString     as N
import qualified Data.Conduit.Network.TLS      as N
import qualified Data.Streaming.Network        as N

import           Data.CaseInsensitive  ( CI )
import qualified Data.CaseInsensitive as CI
import           Control.Concurrent.Async as Async
import 		 Data.ByteString (hPutStr)
import 		 Control.Concurrent (threadDelay)
import           Test.Hspec
import           Data.Binary (decode, encode)


import Tunnel
import Types
import Protocols
import qualified Socks5 as Socks5

testTCPLocalToRemote :: Bool -> IO ()
testTCPLocalToRemote useTLS = do

  Logger.init Logger.VERBOSE

  success <- newIORef False
  let needle = "toto"

  -- SERVER
  let serverPort = 8080
  let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)

  -- CLIENT
  let tunnelSetting = TunnelSettings {
            localBind = "localhost"
          , Types.localPort = fromIntegral 8081
          , serverHost = "localhost"
          , serverPort = fromIntegral serverPort
          , destHost = "localhost"
          , destPort = fromIntegral 8082
          , Types.useTls = useTLS
          , protocol = TCP
          , proxySetting = Nothing
          , useSocks = False
          , upgradePrefix = "wstunnel"
          , udpTimeout = 0
          , upgradeCredentials = ""
          , hostHeader = "toto.com"
          , tlsSNI = "toto.com"
          , websocketPingFrequencySec = 30
          , customHeaders = [(CI.mk "toto", "tata"), (CI.mk "titi", "tutu")]
      }
  let client = runClient tunnelSetting

  -- Remote STUB ENDPOINT
  let remoteSetting = N.serverSettingsTCP (fromIntegral 8082) "localhost"
  let remoteServerEndpoint = N.runTCPServer remoteSetting $ (\sClient -> do N.appRead sClient >>= \payload -> if payload == needle then writeIORef success True else writeIORef success False)

  -- local STUB ENDPOINT
  let localClient = rrunTCPClient (N.clientSettingsTCP (fromIntegral 8081) "localhost") (\cnx -> write cnx needle)

  putStrLn "Starting remote endpoint"
  Async.async $ timeout (10 * 10^6) remoteServerEndpoint
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel server"
  Async.async $ timeout (10 * 10^6) serverWithoutTLS
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel client"
  Async.async $ timeout (10 * 10^6) client
  threadDelay (1 * 10^6)

  putStrLn "Writing data to the pipeline"
  _ <- localClient
  threadDelay (7 * 10^6)

  isSuccess <- readIORef success
  if not isSuccess 
  then throwString "Tunnel is not working"
  else putStrLn "Success"

testUDPLocalToRemote :: Bool -> IO ()
testUDPLocalToRemote useTLS = do

  Logger.init Logger.VERBOSE

  success <- newIORef False
  let needle = "toto"

  -- SERVER
  let serverPort = 8080
  let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)

  -- CLIENT
  let tunnelSetting = TunnelSettings {
            localBind = "localhost"
          , Types.localPort = fromIntegral 8081
          , serverHost = "localhost"
          , serverPort = fromIntegral serverPort
          , destHost = "localhost"
          , destPort = fromIntegral 8082
          , Types.useTls = useTLS
          , protocol = UDP
          , proxySetting = Nothing
          , useSocks = False
          , upgradePrefix = "wstunnel"
          , udpTimeout = -1
          , upgradeCredentials = ""
          , hostHeader = "toto.com"
          , tlsSNI = "toto.com"
          , websocketPingFrequencySec = 30
          , customHeaders = [(CI.mk "toto", "tata"), (CI.mk "titi", "tutu")]
      }
  let client = runClient tunnelSetting

  -- Remote STUB ENDPOINT
  let remoteServerEndpoint = runUDPServer ("localhost", fromIntegral 8082) (-1) $ (\sClient -> do read (toConnection sClient) >>= \(Just payload) -> if payload == needle then writeIORef success True else writeIORef success False)

  -- local STUB ENDPOINT
  let localClient = runUDPClient ("localhost", fromIntegral 8081) (\cnx -> write (toConnection cnx) needle)

  putStrLn "Starting remote endpoint"
  Async.async $ timeout (10 * 10^6) remoteServerEndpoint
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel server"
  Async.async $ timeout (10 * 10^6) serverWithoutTLS
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel client"
  Async.async $ timeout (10 * 10^6) client
  threadDelay (1 * 10^6)

  putStrLn "Writing data to the pipeline"
  _ <- localClient
  threadDelay (7 * 10^6)

  isSuccess <- readIORef success
  if not isSuccess 
  then throwString "Tunnel is not working"
  else putStrLn "Success"

testSocks5Tunneling :: Bool -> IO ()
testSocks5Tunneling useTLS = do

  Logger.init Logger.VERBOSE

  success <- newIORef False
  let needle = "toto"

  -- SERVER
  let serverPort = 8080
  let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)

  -- CLIENT
  let tunnelSetting = TunnelSettings {
            localBind = "localhost"
          , Types.localPort = fromIntegral 8081
          , serverHost = "localhost"
          , serverPort = fromIntegral serverPort
          , destHost = ""
          , destPort = 0
          , Types.useTls = useTLS
          , protocol = SOCKS5
          , proxySetting = Nothing
          , useSocks = False
          , upgradePrefix = "wstunnel"
          , udpTimeout = -1
          , upgradeCredentials = ""
          , hostHeader = "toto.com"
          , tlsSNI = "toto.com"
          , websocketPingFrequencySec = 30
          , customHeaders = [(CI.mk "toto", "tata"), (CI.mk "titi", "tutu")]
      }
  let client = runClient tunnelSetting

  -- Remote STUB ENDPOINT
  let remoteSetting = N.serverSettingsTCP (fromIntegral 8082) "localhost"
  let remoteServerEndpoint = N.runTCPServer remoteSetting $ (\sClient -> do N.appRead sClient >>= \payload -> if payload == needle then writeIORef success True else writeIORef success False)


  putStrLn "Starting remote endpoint"
  Async.async $ timeout (10 * 10^6) remoteServerEndpoint
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel server"
  Async.async $ timeout (10 * 10^6) serverWithoutTLS
  threadDelay (1 * 10^6)

  putStrLn "Starting wstunnel client"
  Async.async $ timeout (10 * 10^6) client
  threadDelay (1 * 10^6)

  putStrLn "Writing data to the pipeline"
  rrunTCPClient (N.clientSettingsTCP (fromIntegral 8081) "localhost") $ \cnx -> do 
    write cnx (toStrict . encode $ Socks5.RequestAuth (fromIntegral Socks5.socksVersion) (fromList [Socks5.NoAuth]))
    _ <- read cnx 
    write cnx (toStrict . encode $ Socks5.Request (fromIntegral Socks5.socksVersion) Socks5.Connect "localhost" 8082)
    _ <- read cnx 
    write cnx needle

  threadDelay (7 * 10^6)

  isSuccess <- readIORef success
  if not isSuccess 
  then throwString "Tunnel is not working"
  else putStrLn "Success"

main :: IO ()
main = hspec $ do
    describe "Socks5 tunneling" $ do
      it "Testing socks5 -D without TLS" $ do
       testSocks5Tunneling False
      it "Testing socks5 -D with TLS" $ do
       testSocks5Tunneling True

    describe "TCP tunneling" $ do
      it "Testing TCP -L without TLS" $ do
       testTCPLocalToRemote False 
      it "Testing TCP -L with TLS" $ do
       testTCPLocalToRemote True

    describe "UDP tunneling" $ do
      it "Testing UDP -L without TLS" $ do
       testUDPLocalToRemote False
      it "Testing UDP -L with TLS" $ do
       testUDPLocalToRemote True