{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} module Network.MoeSocks.UDP where import Control.Lens import Control.Monad import Data.Attoparsec.ByteString import Control.Monad.Writer hiding (listen) import Control.Exception import Data.ByteString (ByteString) import Network.MoeSocks.Helper import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common import Network.MoeSocks.Type import Network.Socket hiding (send, recv, recvFrom, sendTo) import Network.Socket.ByteString import Prelude hiding ((-), take) forwardUDPRequestHandler :: MoeConfig -> Forward -> ByteString -> (Socket,SockAddr) -> IO () forwardUDPRequestHandler aConfig aForwarding aMessage (aSocket, aSockAddr) = do let _c = aConfig let _clientRequest = ClientRequest UDP_port (Domain_name - aForwarding ^. forwardRemoteHost) (aForwarding ^. forwardRemotePort) puts - "L UDP: " <> show _clientRequest _sa <- getSocket (_c ^. remote) (_c ^. remotePort) Datagram logSA "L UDP -->:" (pure _sa) - \(_remoteSocket, _remoteAddr) -> do connect _remoteSocket _remoteAddr (_encrypt, _decrypt) <- getCipher (aConfig ^. method) (aConfig ^. password) {-let (_encrypt, _decrypt) = (pure, pure)-} let _header = shadowSocksRequestBuilder _clientRequest let _msg = builder_To_ByteString _header <> aMessage puts - "L UDP: " <> show _msg send_ _remoteSocket =<< _encrypt _msg _r <- recv_ _remoteSocket >>= _decrypt puts - "L UDP <--: " <> show _r when (_r & isn't _Empty) - do sendAllTo aSocket _r aSockAddr remoteUDPRequestHandler:: MoeConfig -> ByteString -> (Socket, SockAddr) -> IO () remoteUDPRequestHandler aConfig aMessage (aSocket, aSockAddr) = do (_encrypt, _decrypt) <- getCipher (aConfig ^. method) (aConfig ^. password) {-let (_encrypt, _decrypt) = (pure, pure)-} _msg <- _decrypt aMessage (_decryptedMessage, _clientRequest) <- case parse (shadowSocksRequestParser UDP_port) _msg of Done _i _r -> pure (_i, _r) _ -> throwIO - ParseException - "R Failed to parse UDP request" puts - "R UDP: " <> show _clientRequest puts - "R UDP: " <> show _decryptedMessage logSA "R UDP -->:" (initTarget _clientRequest) - \_r -> do let (_clientSocket, _clientAddr) = _r puts - "R UDP clientSocket: " <> show _r connect _clientSocket _clientAddr send_ _clientSocket _decryptedMessage _r <- recv_ _clientSocket puts - "R UDP <--: " <> show _r when (_r & isn't _Empty) - do _encryptedMessage <- _encrypt _r sendAllTo aSocket _encryptedMessage aSockAddr