keter 1.0.1.2 → 1.1.0
raw patch · 4 files changed
+39/−16 lines, 4 filesdep +http-clientdep +http-client-conduitdep ~http-conduitdep ~http-reverse-proxydep ~wai
Dependencies added: http-client, http-client-conduit
Dependency ranges changed: http-conduit, http-reverse-proxy, wai, wai-app-static
Files
- Keter/Main.hs +2/−2
- Keter/Proxy.hs +4/−4
- Network/HTTP/ReverseProxy/Rewrite.hs +26/−5
- keter.cabal +7/−5
Keter/Main.hs view
@@ -37,7 +37,7 @@ import qualified Filesystem as F import qualified Filesystem.Path.CurrentOS as F import Filesystem.Path.CurrentOS ((</>), hasExtension)-import qualified Network.HTTP.Conduit as HTTP (newManager)+import qualified Network.HTTP.Conduit as HTTP (newManager, conduitManagerSettings) import qualified System.FSNotify as FSN import System.Posix.User (getUserEntryForID, getUserEntryForName, userGroupID,@@ -175,7 +175,7 @@ startListening :: KeterConfig -> HostMan.HostManager -> IO () startListening KeterConfig {..} hostman = do- manager <- HTTP.newManager def+ manager <- HTTP.newManager HTTP.conduitManagerSettings runAndBlock kconfigListeners $ Proxy.reverseProxy kconfigIpFromHeader manager
Keter/Proxy.hs view
@@ -111,12 +111,12 @@ | encodeUtf8 path == Wai.rawPathInfo req = sendTo $ mkUrl dest | otherwise = other - noAction = Wai.ResponseBuilder+ noAction = Wai.responseBuilder status404 [("Content-Type", "text/plain")] (copyByteString "File not found") - sendTo url = Wai.ResponseBuilder+ sendTo url = Wai.responseBuilder status [("Location", url)] (copyByteString url)@@ -144,13 +144,13 @@ ] missingHostResponse :: Wai.Response-missingHostResponse = Wai.ResponseBuilder+missingHostResponse = Wai.responseBuilder status200 [("Content-Type", "text/html; charset=utf-8")] $ copyByteString "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>You did not provide a virtual hostname for this request.</p></body></html>" unknownHostResponse :: ByteString -> Wai.Response-unknownHostResponse host = Wai.ResponseBuilder+unknownHostResponse host = Wai.responseBuilder status200 [("Content-Type", "text/html; charset=utf-8")] (copyByteString "<!DOCTYPE html>\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>The hostname you have provided, <code>"
Network/HTTP/ReverseProxy/Rewrite.hs view
@@ -17,6 +17,8 @@ import Data.Map ( Map ) import Data.Array ((!)) import Data.Aeson+import Control.Monad (unless)+import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as S import qualified Data.Text as T@@ -40,6 +42,8 @@ import qualified Network.Wai as Wai import Network.HTTP.Conduit+import Network.HTTP.Client (responseOpen, responseClose)+import Network.HTTP.Client.Internal (brRead) import Network.HTTP.Types data RPEntry = RPEntry@@ -111,7 +115,7 @@ mkRuleMap :: Set RewriteRule -> Map HeaderName RewriteRule mkRuleMap = Map.fromList . map (\k -> (CI.mk . encodeUtf8 $ ruleHeader k, k)) . Set.toList -mkRequest :: ReverseProxyConfig -> Wai.Request -> Request (ResourceT IO)+mkRequest :: ReverseProxyConfig -> Wai.Request -> Request mkRequest rpConfig request = def { method = Wai.requestMethod request , secure = reverseUseSSL rpConfig@@ -122,8 +126,8 @@ , requestHeaders = filterHeaders $ rewriteHeaders reqRuleMap (Wai.requestHeaders request) , requestBody = case Wai.requestBodyLength request of- Wai.ChunkedBody -> RequestBodySourceChunked (mapOutput fromByteString $ Wai.requestBody request)- Wai.KnownLength n -> RequestBodySource (fromIntegral n) (mapOutput fromByteString $ Wai.requestBody request)+ Wai.ChunkedBody -> requestBodySourceChunkedIO (Wai.requestBody request)+ Wai.KnownLength n -> requestBodySourceIO (fromIntegral n) (Wai.requestBody request) , decompress = const False , redirectCount = 0 , checkStatus = \_ _ _ -> Nothing@@ -134,9 +138,16 @@ reqRuleMap = mkRuleMap $ rewriteRequestRules rpConfig simpleReverseProxy :: Manager -> ReverseProxyConfig -> Wai.Application-simpleReverseProxy mgr rpConfig request =+simpleReverseProxy mgr rpConfig request = Wai.responseSourceBracket+ (responseOpen proxiedRequest mgr)+ responseClose+ $ \res -> return+ ( responseStatus res+ , rewriteHeaders respRuleMap $ responseHeaders res+ , bodyReaderSource $ responseBody res+ )+ {- do- let proxiedRequest = mkRequest rpConfig request response <- http proxiedRequest mgr (body, _) <- unwrapResumable $ responseBody response return $@@ -144,8 +155,18 @@ (responseStatus response) (rewriteHeaders respRuleMap $ responseHeaders response) (mapOutput (Chunk . fromByteString) body)+ -} where+ proxiedRequest = mkRequest rpConfig request respRuleMap = mkRuleMap $ rewriteResponseRules rpConfig+ bodyReaderSource br =+ loop+ where+ loop = do+ bs <- liftIO $ brRead br+ unless (S.null bs) $ do+ yield $ Chunk $ fromByteString bs+ loop data ReverseProxyConfig = ReverseProxyConfig { reversedHost :: Text
keter.cabal view
@@ -1,5 +1,5 @@ Name: keter-Version: 1.0.1.2+Version: 1.1.0 Synopsis: Web application deployment manager, focusing on Haskell web frameworks Description: Handles deployment of web apps, providing a reverse proxy to achieve zero downtime deployments. For more information, please see the README on Github: <https://github.com/snoyberg/keter#readme>@@ -51,15 +51,17 @@ , conduit >= 0.5 , network-conduit >= 0.6 , network-conduit-tls >= 1.0.0.2- , http-reverse-proxy >= 0.2 && < 0.3+ , http-reverse-proxy >= 0.3 && < 0.4 , unix-process-conduit >= 0.2.2 && < 0.3 , unix >= 2.5 && < 2.7- , wai-app-static >= 1.3 && < 1.4- , wai >= 1.4 && < 1.5+ , wai-app-static >= 2.0 && < 2.1+ , wai >= 2.0 && < 2.1 , http-types , regex-tdfa >= 1.1 , attoparsec >= 0.10- , http-conduit+ , http-conduit >= 2.0+ , http-client+ , http-client-conduit , case-insensitive , array , mtl