sproxy: bump

2 files changed, 240 insertions, 13 deletions

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 <sol@typeful.net>
+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
+