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 { };
|
spiped = callPackage ../tools/networking/spiped { };
|
||||||
|
|
||||||
sproxy = haskellPackages.callPackage ../tools/networking/sproxy { };
|
|
||||||
|
|
||||||
sproxy-web = haskellPackages.callPackage ../tools/networking/sproxy-web { };
|
|
||||||
|
|
||||||
sqliteman = callPackage ../applications/misc/sqliteman { };
|
sqliteman = callPackage ../applications/misc/sqliteman { };
|
||||||
|
|
||||||
stardict = callPackage ../applications/misc/stardict/stardict.nix {
|
stardict = callPackage ../applications/misc/stardict/stardict.nix {
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user