Drop broken packages sproxy and sproxy-web.
This commit is contained in:
Peter Simons
parent
956f6dbd4a
commit
a510ba0334
@ -1,27 +0,0 @@
|
||||
{ cabal, aeson, blazeHtml, blazeMarkup, configurator, hflags
|
||||
, httpTypes, mtl, postgresqlSimple, resourcePool, scotty, text
|
||||
, waiExtra, waiMiddlewareStatic, fetchurl
|
||||
}:
|
||||
|
||||
cabal.mkDerivation (self: {
|
||||
pname = "sproxy-web";
|
||||
version = "0.1.0.2";
|
||||
src = fetchurl {
|
||||
url = "https://github.com/zalora/sproxy-web/archive/0.1.0.2.tar.gz";
|
||||
sha256 = "1rdzglvsas0rdgq3j5c9ll411yk168x7v3l7w8zdjgafa947j4d4";
|
||||
};
|
||||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
buildDepends = [
|
||||
aeson blazeHtml blazeMarkup configurator hflags httpTypes mtl
|
||||
postgresqlSimple resourcePool scotty text waiExtra
|
||||
waiMiddlewareStatic
|
||||
];
|
||||
meta = {
|
||||
homepage = "http://bitbucket.org/zalorasea/sproxy-web";
|
||||
description = "Web interface to sproxy";
|
||||
license = self.stdenv.lib.licenses.bsd3;
|
||||
platforms = self.ghc.meta.platforms;
|
||||
broken = true;
|
||||
};
|
||||
})
|
||||
@ -1,40 +0,0 @@
|
||||
{ cabal, aeson, attoparsec, caseInsensitive, certificate
|
||||
, 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.8.0";
|
||||
src = fetchurl {
|
||||
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 httpKit httpTypes
|
||||
interpolatedstringPerl6 mtl network optparseApplicative
|
||||
postgresqlSimple safe SHA split stringConversions time tls
|
||||
unorderedContainers utf8String x509 yaml
|
||||
];
|
||||
testDepends = [
|
||||
aeson attoparsec caseInsensitive certificate 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
|
||||
];
|
||||
meta = {
|
||||
license = self.stdenv.lib.licenses.mit;
|
||||
platforms = self.ghc.meta.platforms;
|
||||
broken = true;
|
||||
};
|
||||
})
|
||||
@ -1,224 +0,0 @@
|
||||
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
|
||||
|
||||
@ -2725,10 +2725,6 @@ let
|
||||
|
||||
spiped = callPackage ../tools/networking/spiped { };
|
||||
|
||||
sproxy = haskellPackages.callPackage ../tools/networking/sproxy { };
|
||||
|
||||
sproxy-web = haskellPackages.callPackage ../tools/networking/sproxy-web { };
|
||||
|
||||
sqliteman = callPackage ../applications/misc/sqliteman { };
|
||||
|
||||
stardict = callPackage ../applications/misc/stardict/stardict.nix {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user