diff --git a/pkgs/tools/networking/sproxy/default.nix b/pkgs/tools/networking/sproxy/default.nix index 342da193ffc7..10ec9b40cd43 100644 --- a/pkgs/tools/networking/sproxy/default.nix +++ b/pkgs/tools/networking/sproxy/default.nix @@ -1,33 +1,36 @@ { cabal, aeson, attoparsec, caseInsensitive, certificate -, concurrentExtra, cryptoRandom, curl, dataDefault, hslogger, hspec -, HTTP, httpTypes, interpolatedstringPerl6, mtl, network -, optparseApplicative, postgresqlSimple, safe, SHA, split -, stringConversions, time, tls, unorderedContainers, utf8String -, x509, yaml, fetchurl +, concurrentExtra, conduit, connection, cryptoRandom, curl +, dataDefault, hslogger, hspec, httpConduit, httpKit, httpTypes +, interpolatedstringPerl6, mtl, network, optparseApplicative +, postgresqlSimple, safe, SHA, split, stringConversions, time, tls +, unorderedContainers, utf8String, wai, warp, x509, yaml, fetchurl }: cabal.mkDerivation (self: { pname = "sproxy"; - version = "0.7.4"; + version = "0.8.0"; src = fetchurl { - url = "https://github.com/zalora/sproxy/archive/0.7.4.tar.gz"; - sha256 = "1zlsln0ihg7p8jk5gdvm9as6gk4fs8vaa547iq2yvna4c1wb4amr"; + url = "https://github.com/zalora/sproxy/archive/0.8.0.tar.gz"; + sha256 = "11xn4k509ck73pacyz2kh0924n2vy8rwakwd42dwbvhhysf47rdx"; }; isLibrary = false; isExecutable = true; + patches = [ ./new-http-kit.patch ]; + doCheck = false; buildDepends = [ aeson attoparsec caseInsensitive certificate concurrentExtra - cryptoRandom curl dataDefault hslogger HTTP httpTypes + cryptoRandom curl dataDefault hslogger httpKit httpTypes interpolatedstringPerl6 mtl network optparseApplicative postgresqlSimple safe SHA split stringConversions time tls unorderedContainers utf8String x509 yaml ]; testDepends = [ aeson attoparsec caseInsensitive certificate concurrentExtra - cryptoRandom curl dataDefault hslogger hspec HTTP httpTypes - interpolatedstringPerl6 mtl network optparseApplicative - postgresqlSimple safe SHA split stringConversions time tls - unorderedContainers utf8String x509 yaml + conduit connection cryptoRandom curl dataDefault hslogger hspec + httpConduit httpKit httpTypes interpolatedstringPerl6 mtl network + optparseApplicative postgresqlSimple safe SHA split + stringConversions time tls unorderedContainers utf8String wai warp + x509 yaml ]; meta = { license = self.stdenv.lib.licenses.mit; diff --git a/pkgs/tools/networking/sproxy/new-http-kit.patch b/pkgs/tools/networking/sproxy/new-http-kit.patch new file mode 100644 index 000000000000..c15c3f3989a9 --- /dev/null +++ b/pkgs/tools/networking/sproxy/new-http-kit.patch @@ -0,0 +1,224 @@ +From 383d2cbe240600a86ab99fdefcea4e913d171ec6 Mon Sep 17 00:00:00 2001 +From: Simon Hengel +Date: Thu, 24 Apr 2014 22:51:02 +0800 +Subject: [PATCH] Depend on http-kit >= 0.2 + +--- + sproxy.cabal | 2 +- + src/Authenticate.hs | 17 ++++++++--------- + src/HTTP.hs | 47 +++++++++-------------------------------------- + src/Proxy.hs | 32 ++++++++++++++------------------ + 4 files changed, 32 insertions(+), 66 deletions(-) + +diff --git a/sproxy.cabal b/sproxy.cabal +index 08e1d61..91adf5d 100644 +--- a/sproxy.cabal ++++ b/sproxy.cabal +@@ -49,7 +49,7 @@ executable sproxy + unix, + utf8-string, + x509, +- http-kit, ++ http-kit >= 0.2, + yaml >= 0.8 + default-language: Haskell2010 + ghc-options: -Wall -threaded -O2 +diff --git a/src/Authenticate.hs b/src/Authenticate.hs +index 7d4c218..15a69a9 100644 +--- a/src/Authenticate.hs ++++ b/src/Authenticate.hs +@@ -30,8 +30,7 @@ import System.Posix.Types (EpochTime) + import System.Posix.Time (epochTime) + import Data.Digest.Pure.SHA (hmacSha1, showDigest) + +-import Network.HTTP.Toolkit.Header +-import Network.HTTP.Toolkit.Request ++import Network.HTTP.Toolkit + + import Type + import Cookies +@@ -90,19 +89,19 @@ instance FromJSON UserInfo where + + -- https://wiki.zalora.com/Main_Page -> https://wiki.zalora.com/ + -- Note that this always uses https: +-rootURI :: RequestHeader -> URI.URI +-rootURI (MessageHeader _ headers) = ++rootURI :: Request a -> URI.URI ++rootURI (Request _ _ headers _) = + let host = cs $ fromMaybe (error "Host header not found") $ lookup "Host" headers + in URI.URI "https:" (Just $ URI.URIAuth "" host "") "/" "" "" + +-redirectForAuth :: AuthConfig -> RequestHeader -> SendData -> IO () +-redirectForAuth c request@(MessageHeader (_, path_) _) send = do ++redirectForAuth :: AuthConfig -> Request a -> SendData -> IO () ++redirectForAuth c request@(Request _ path_ _ _) send = do + let redirectUri = rootURI request + path = urlEncode True path_ + authURL = "https://accounts.google.com/o/oauth2/auth?scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.email+https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.profile&state=" ++ cs path ++ "&redirect_uri=" ++ (cs $ show $ redirectUri) ++ "&response_type=code&client_id=" ++ authConfigClientID c ++ "&approval_prompt=force&access_type=offline" +- sendResponse send found302 [("Location", UTF8.fromString $ authURL)] "" ++ sendResponse_ send found302 [("Location", UTF8.fromString $ authURL)] "" + +-authenticate :: AuthConfig -> SendData -> RequestHeader -> ByteString -> ByteString -> IO () ++authenticate :: AuthConfig -> SendData -> Request a -> ByteString -> ByteString -> IO () + authenticate config send request path code = do + tokenRes <- post "https://accounts.google.com/o/oauth2/token" ["code=" ++ UTF8.toString code, "client_id=" ++ clientID, "client_secret=" ++ clientSecret, "redirect_uri=" ++ (cs $ show $ rootURI request), "grant_type=authorization_code"] + case tokenRes of +@@ -121,7 +120,7 @@ authenticate config send request path code = do + Just userInfo -> do + clientToken <- authToken authTokenKey (userEmail userInfo) (userGivenName userInfo, userFamilyName userInfo) + let cookie = setCookie cookieDomain cookieName (show clientToken) authShelfLife +- sendResponse send found302 [("Location", cs $ (show $ (rootURI request) {URI.uriPath = ""}) ++ cs (urlDecode False path)), ("Set-Cookie", UTF8.fromString cookie)] "" ++ sendResponse_ send found302 [("Location", cs $ (show $ (rootURI request) {URI.uriPath = ""}) ++ cs (urlDecode False path)), ("Set-Cookie", UTF8.fromString cookie)] "" + where + cookieDomain = authConfigCookieDomain config + cookieName = authConfigCookieName config +diff --git a/src/HTTP.hs b/src/HTTP.hs +index 07038a0..dbcae71 100644 +--- a/src/HTTP.hs ++++ b/src/HTTP.hs +@@ -1,19 +1,14 @@ + {-# LANGUAGE OverloadedStrings #-} + module HTTP ( +- sendRequest +-, sendResponse +-, sendResponse_ ++ sendResponse_ + , internalServerError + ) where + +-import Data.Foldable (forM_) + import Data.ByteString (ByteString) +-import qualified Data.ByteString as B +-import qualified Data.ByteString.Char8 as B8 +-import qualified Data.ByteString.UTF8 as UTF8 +-import qualified Data.CaseInsensitive as CI ++import qualified Data.ByteString.Char8 as B + import Network.HTTP.Types +-import Network.HTTP.Toolkit.Body ++import Network.HTTP.Toolkit ++import qualified Network.HTTP.Toolkit.Body as Body + + import Type + import qualified Log +@@ -21,34 +16,10 @@ import qualified Log + internalServerError :: SendData -> String -> IO () + internalServerError send err = do + Log.debug $ show err +- sendResponse send internalServerError500 [] "Internal Server Error" ++ sendResponse_ send internalServerError500 [] "Internal Server Error" + +-sendRequest :: SendData -> Method -> ByteString -> [Header] -> BodyReader -> IO () +-sendRequest send method path headers body = do +- sendHeader send startLine headers +- sendBody send body ++sendResponse_ :: SendData -> Status -> [Header] -> ByteString -> IO () ++sendResponse_ send status headers_ body = do ++ Body.fromByteString body >>= sendResponse send . Response status headers + where +- startLine = B8.unwords [method, path, "HTTP/1.1"] +- +-sendResponse :: SendData -> Status -> [Header] -> ByteString -> IO () +-sendResponse send status headers_ body = do +- sendHeader send (statusLine status) headers +- send body +- where +- headers = ("Content-Length", UTF8.fromString $ show $ B.length body) : headers_ +- +-sendResponse_ :: SendData -> Status -> [Header] -> BodyReader -> IO () +-sendResponse_ send status headers body = do +- sendHeader send (statusLine status) headers +- sendBody send body +- +-statusLine :: Status -> ByteString +-statusLine status = B.concat ["HTTP/1.1 ", UTF8.fromString $ show (statusCode status), " ", statusMessage status] +- +-sendHeader :: SendData -> ByteString -> [Header] -> IO () +-sendHeader send startLine headers = do +- send startLine +- send "\r\n" +- forM_ headers $ \(k, v) -> do +- send $ B.concat [CI.original k, ": ", v, "\r\n"] +- send "\r\n" ++ headers = ("Content-Length", B.pack . show . B.length $ body) : headers_ +diff --git a/src/Proxy.hs b/src/Proxy.hs +index aa320af..88b95d9 100644 +--- a/src/Proxy.hs ++++ b/src/Proxy.hs +@@ -32,11 +32,7 @@ import qualified Network.URI as URI + import Options.Applicative hiding (action) + import System.IO + +-import Network.HTTP.Toolkit.Body +-import Network.HTTP.Toolkit.Header +-import Network.HTTP.Toolkit.Connection +-import Network.HTTP.Toolkit.Request +-import Network.HTTP.Toolkit.Response ++import Network.HTTP.Toolkit + + import Type + import Util +@@ -142,10 +138,10 @@ runProxy port config authConfig authorize = (listen port (serve config authConfi + redirectToHttps :: SockAddr -> Socket -> IO () + redirectToHttps _ sock = do + conn <- makeConnection (Socket.recv sock 4096) +- (request, _) <- readRequest conn +- sendResponse (Socket.sendAll sock) seeOther303 [("Location", cs $ show $ requestURI request)] "" ++ request <- readRequest conn ++ sendResponse_ (Socket.sendAll sock) seeOther303 [("Location", cs $ show $ requestURI request)] "" + where +- requestURI (MessageHeader (_, path) headers) = ++ requestURI (Request _ path headers _) = + let host = fromMaybe (error "Host header not found") $ lookup "Host" headers + in fromJust $ URI.parseURI $ "https://" ++ cs host ++ cs path + +@@ -171,8 +167,8 @@ serve config authConfig withAuthorizeAction addr sock = do + serve_ send conn authorize = go + where + go :: IO () +- go = forever $ readRequest conn >>= \(request, body) -> case request of +- MessageHeader (_, url) headers -> do ++ go = forever $ readRequest conn >>= \request -> case request of ++ Request _ url headers _ -> do + -- TODO: Don't loop for more input on Connection: close header. + -- Check if this is an authorization response. + case URI.parseURIReference $ BU.toString url of +@@ -192,17 +188,17 @@ serve config authConfig withAuthorizeAction addr sock = do + case auth of + Nothing -> redirectForAuth authConfig request send + Just token -> do +- forwardRequest config send authorize cookies addr request body token ++ forwardRequest config send authorize cookies addr request token + + -- Check our access control list for this user's request and forward it to the backend if allowed. +-forwardRequest :: Config -> SendData -> AuthorizeAction -> [(Name, Cookies.Value)] -> SockAddr -> RequestHeader -> BodyReader -> AuthToken -> IO () +-forwardRequest config send authorize cookies addr (MessageHeader (method, path) headers) body token = do ++forwardRequest :: Config -> SendData -> AuthorizeAction -> [(Name, Cookies.Value)] -> SockAddr -> Request BodyReader -> AuthToken -> IO () ++forwardRequest config send authorize cookies addr request@(Request method path headers _) token = do + groups <- authorize (authEmail token) (maybe (error "No Host") cs $ lookup "Host" headers) path method + ip <- formatSockAddr addr + case groups of + [] -> do + -- TODO: Send back a page that allows the user to request authorization. +- sendResponse send forbidden403 [] "Access Denied" ++ sendResponse_ send forbidden403 [] "Access Denied" + _ -> do + -- TODO: Reuse connections to the backend server. + let downStreamHeaders = +@@ -216,10 +212,10 @@ forwardRequest config send authorize cookies addr (MessageHeader (method, path) + setCookies $ + fromList headers + bracket (connectTo host port) hClose $ \h -> do +- sendRequest (B.hPutStr h) method path downStreamHeaders body +- conn <- makeConnection (B.hGetSome h 4096) +- (MessageHeader status responseHeaders, responseBody) <- readResponse method conn +- sendResponse_ send status (removeConnectionHeader responseHeaders) responseBody ++ sendRequest (B.hPutStr h) request{requestHeaders = downStreamHeaders} ++ conn <- connectionFromHandle h ++ response <- readResponse method conn ++ sendResponse send response{responseHeaders = removeConnectionHeader (responseHeaders response)} + where + host = configBackendAddress config + port = PortNumber (configBackendPort config) +-- +1.9.1 +