From 001619f7b134f5bf518921064f6de75ff7fe6619 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=CE=A3rebe=20-=20Romain=20GERARD?= Date: Sat, 29 Oct 2022 19:42:49 +0200 Subject: [PATCH] lint Former-commit-id: c28e4cf38fd7e8b55d6453cc7ada8eef3cb722a8 Former-commit-id: 0e8573342851be0e0812a9d92548d65e1d234fdf [formerly 0ec3417203a97ffba77fad8074234e0009bbd578] [formerly 354294f60f429b260e49e3cd647d36b0aa360cf2 [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 2b55b3e5cefc3c9c908a54600772774d92aea898]]]]] Former-commit-id: 2fd3f1de8cdd14032219415083519e8f5b49283f [formerly 85e94bf33bd4caa21f9db9bf0d4013f1218b94c3] Former-commit-id: 86e9b904cd8018f72094e3da79d05d072cee9d9a Former-commit-id: 4601d50c8322c295bc91572481a13d15c4d3d4f7 Former-commit-id: eea6001db6f78629d3b22b094c02f1aad0f7e754 Former-commit-id: 68980f8021f05d20bcb61de43d008e9fae3ad611 [formerly 77587a0a95a23f76bd395ddd6078f85114e1c606] Former-commit-id: f80fc49e44f9cfe329f76d4f02e7742e8fa41f9b --- src/HttpProxy.hs | 4 ++-- src/Socks5.hs | 18 ++++-------------- src/Tunnel.hs | 6 ++++-- 3 files changed, 10 insertions(+), 18 deletions(-) diff --git a/src/HttpProxy.hs b/src/HttpProxy.hs index 224f208..ada3ebf 100644 --- a/src/HttpProxy.hs +++ b/src/HttpProxy.hs @@ -58,7 +58,7 @@ httpProxyConnection HttpProxySettings{..} (host, port) app = onError $ do 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" + <> "Host: " <> fromString host <> ":" <> fromString (show port) <> "\r\n" <> maybe mempty credentialsToHeader credentials <> "\r\n" @@ -75,6 +75,6 @@ httpProxyConnection HttpProxySettings{..} (host, port) app = onError $ do isAuthorized response = " 200 " `isInfixOf` response onError f = catch f $ \(e :: SomeException) -> return $ - if (take 10 (show e) == "user error") + if take 10 (show e) == "user error" then throwError $ ProxyConnectionError (show e) else throwError $ ProxyConnectionError ("Unknown Error :: " <> show e) diff --git a/src/Socks5.hs b/src/Socks5.hs index 933ff22..df67352 100644 --- a/src/Socks5.hs +++ b/src/Socks5.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} @@ -73,7 +72,7 @@ instance Binary RequestAuth where put RequestAuth{..} = do putWord8 (fromIntegral version) putWord8 (fromIntegral $ length methods) - sequence_ (put <$> methods) + mapM_ put methods -- Check length <= 255 get = do @@ -134,8 +133,7 @@ instance Binary Request where host <- if opCode == 0x03 then do length <- fromIntegral <$> getWord8 - host <- either (const T.empty) id . E.decodeUtf8' <$> replicateM length getWord8 - return host + fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8 else do ipv4 <- replicateM 4 getWord8 :: Get [Word8] let ipv4Str = T.intercalate "." $ fmap (tshow . fromEnum) ipv4 @@ -200,7 +198,7 @@ instance Binary Response where opCode <- fromIntegral <$> getWord8 -- Type guard(opCode == 0x03) length <- fromIntegral <$> getWord8 - host <- either (const T.empty) id . E.decodeUtf8' <$> replicateM length getWord8 + host <- fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8 guard (not $ null host) port <- getWord16be @@ -219,12 +217,4 @@ data ServerSettings = ServerSettings , bindOn :: HostName -- , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth -- , onRequest :: (MonadIO m, MonadError IOException m) => Request -> m Response - } deriving (Show) - - - - - - - - -- + } deriving (Show) \ No newline at end of file diff --git a/src/Tunnel.hs b/src/Tunnel.hs index 778b0ec..26ee1e5 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -64,9 +64,9 @@ tunnelingClientP cfg@TunnelSettings{..} app conn = onError $ do debug "Opening Websocket stream" stream <- connectionToStream conn - let authorization = if not (null upgradeCredentials) then [("Authorization", "Basic " <> B64.encode upgradeCredentials)] else [] + let authorization = ([("Authorization", "Basic " <> B64.encode upgradeCredentials) | not (null upgradeCredentials)]) let headers = authorization <> customHeaders - let hostname = if not (null hostHeader) then (BC.unpack hostHeader) else serverHost + let hostname = if not (null hostHeader) then BC.unpack hostHeader else serverHost ret <- WS.runClientWithStream stream hostname (toPath cfg) WS.defaultConnectionOptions headers run @@ -240,6 +240,8 @@ serverEventLoop sClient isAllowed pendingConn = do case proto of UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (\cnx -> void $ toConnection conn <==> toConnection cnx) TCP -> runTCPClient (BC.unpack rhost, fromIntegral rport) (\cnx -> void $ toConnection conn <==> toConnection cnx) + STDIO -> mempty + SOCKS5 -> mempty runServer :: Bool -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()