From f28556e4d763170168e124dc763a3eba6be5b88c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 25 Jul 2013 14:18:32 +0300 Subject: [PATCH] Extract reverse proxy rewrite rules --- Keter/HostManager.hs | 4 +- Keter/Main.hs | 2 +- Keter/Proxy.hs | 4 +- Keter/Types.hs | 3 +- Keter/Types/V04.hs | 46 +---------------- Keter/Types/V10.hs | 3 +- .../HTTP/ReverseProxy/Rewrite.hs | 51 +++++++++++++++++-- keter.cabal | 2 +- 8 files changed, 59 insertions(+), 56 deletions(-) rename Keter/ReverseProxy.hs => Network/HTTP/ReverseProxy/Rewrite.hs (76%) diff --git a/Keter/HostManager.hs b/Keter/HostManager.hs index a7eb0c1..f46f0b3 100644 --- a/Keter/HostManager.hs +++ b/Keter/HostManager.hs @@ -28,7 +28,7 @@ import Data.ByteString.Char8 () import qualified Network import qualified Data.ByteString as S import Data.Text.Encoding (encodeUtf8) -import qualified Keter.ReverseProxy as ReverseProxy (RPEntry) +import Network.HTTP.ReverseProxy.Rewrite (RPEntry) import Keter.Types data Command = GetPort (Either SomeException Port -> KIO ()) @@ -124,7 +124,7 @@ addEntry (HostManager f) h p = f $ case h of "*" -> AddDefaultEntry p _ -> AddEntry h p -data HostEntry = PEPort Port | PEStatic FilePath | PERedirect S.ByteString | PEReverseProxy ReverseProxy.RPEntry +data HostEntry = PEPort Port | PEStatic FilePath | PERedirect S.ByteString | PEReverseProxy RPEntry -- | Remove an entry from the configuration and reload nginx. removeEntry :: HostManager -> Host -> KIO () diff --git a/Keter/Main.hs b/Keter/Main.hs index bc5d59f..1b70cf1 100644 --- a/Keter/Main.hs +++ b/Keter/Main.hs @@ -14,7 +14,7 @@ import qualified Keter.App as App import Keter.Types import qualified Keter.HostManager as HostMan import qualified Keter.Proxy as Proxy -import qualified Keter.ReverseProxy as ReverseProxy +import qualified Network.HTTP.ReverseProxy.Rewrite as Rewrite import System.Posix.Files (modificationTime, getFileStatus) import System.Posix.Signals (sigHUP, installHandler, Handler (Catch)) import qualified Data.Conduit.LogFile as LogFile diff --git a/Keter/Proxy.hs b/Keter/Proxy.hs index ef45106..0388a27 100644 --- a/Keter/Proxy.hs +++ b/Keter/Proxy.hs @@ -17,7 +17,7 @@ import Network.HTTP.ReverseProxy (waiProxyToSettings, wpsSetIpHeader, SetIpHeade import Network.Wai.Application.Static (defaultFileServerSettings, staticApp) import qualified Network.Wai as Wai import Network.HTTP.Types (status301, status200) -import qualified Keter.ReverseProxy as ReverseProxy +import qualified Network.HTTP.ReverseProxy.Rewrite as Rewrite import Network.HTTP.Conduit (Manager) import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as WarpTLS @@ -54,7 +54,7 @@ withClient useHeader manager portLookup = Just (PEPort port) -> return $ WPRProxyDest $ ProxyDest "127.0.0.1" port Just (PEStatic root) -> fmap WPRResponse $ staticApp (defaultFileServerSettings root) req Just (PERedirect host) -> return $ WPRResponse $ redirectApp host req - Just (PEReverseProxy rpentry) -> fmap WPRResponse $ ReverseProxy.simpleReverseProxy rpentry req + Just (PEReverseProxy rpentry) -> fmap WPRResponse $ Rewrite.simpleReverseProxy rpentry req where mhost = lookup "host" $ Wai.requestHeaders req diff --git a/Keter/Types.hs b/Keter/Types.hs index 9791fbe..366b72a 100644 --- a/Keter/Types.hs +++ b/Keter/Types.hs @@ -3,7 +3,7 @@ module Keter.Types ) where import Keter.Types.Common as X -import Keter.Types.V04 as X (ReverseProxyConfig (..), RewriteRule (..), PortSettings (..), TLSConfig (..)) +import Keter.Types.V04 as X (PortSettings (..), TLSConfig (..)) import Keter.Types.V10 as X ( BundleConfig (..) , WebAppConfig (..) @@ -12,3 +12,4 @@ import Keter.Types.V10 as X , KeterConfig (..) , Stanza (..) ) +import Network.HTTP.ReverseProxy.Rewrite (ReverseProxyConfig (..), RewriteRule (..)) diff --git a/Keter/Types/V04.hs b/Keter/Types/V04.hs index 0391c89..42fbe8b 100644 --- a/Keter/Types/V04.hs +++ b/Keter/Types/V04.hs @@ -19,6 +19,7 @@ import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as WarpTLS import Filesystem.Path.CurrentOS (encodeString) import Keter.Types.Common +import Network.HTTP.ReverseProxy.Rewrite data AppConfig = AppConfig { configExec :: F.FilePath @@ -140,48 +141,3 @@ instance Default PortSettings where instance FromJSON PortSettings where parseJSON = withObject "PortSettings" $ \_ -> PortSettings <$> return (portRange def) - -data ReverseProxyConfig = ReverseProxyConfig - { reversedHost :: Text - , reversedPort :: Int - , reversingHost :: Text - , reverseUseSSL :: Bool - , reverseTimeout :: Maybe Int - , rewriteResponseRules :: Set RewriteRule - , rewriteRequestRules :: Set RewriteRule - } deriving (Eq, Ord) - -instance FromJSON ReverseProxyConfig where - parseJSON (Object o) = ReverseProxyConfig - <$> o .: "reversed-host" - <*> o .: "reversed-port" - <*> o .: "reversing-host" - <*> o .:? "ssl" .!= False - <*> o .:? "timeout" .!= Nothing - <*> o .:? "rewrite-response" .!= Set.empty - <*> o .:? "rewrite-request" .!= Set.empty - parseJSON _ = fail "Wanted an object" - -instance Default ReverseProxyConfig where - def = ReverseProxyConfig - { reversedHost = "" - , reversedPort = 80 - , reversingHost = "" - , reverseUseSSL = False - , reverseTimeout = Nothing - , rewriteResponseRules = Set.empty - , rewriteRequestRules = Set.empty - } - -data RewriteRule = RewriteRule - { ruleHeader :: Text - , ruleRegex :: Text - , ruleReplacement :: Text - } deriving (Eq, Ord) - -instance FromJSON RewriteRule where - parseJSON (Object o) = RewriteRule - <$> o .: "header" - <*> o .: "from" - <*> o .: "to" - parseJSON _ = fail "Wanted an object" diff --git a/Keter/Types/V10.hs b/Keter/Types/V10.hs index 494024d..3c79acd 100644 --- a/Keter/Types/V10.hs +++ b/Keter/Types/V10.hs @@ -19,6 +19,7 @@ import Data.Conduit.Network (HostPreference) import Data.Vector (Vector) import qualified Data.Vector as V import Data.Monoid (mempty) +import Network.HTTP.ReverseProxy.Rewrite (ReverseProxyConfig) data BundleConfig = BundleConfig { bconfigStanzas :: !(Vector Stanza) @@ -95,7 +96,7 @@ instance ParseYamlFile KeterConfig where data Stanza = StanzaStaticFiles StaticFilesConfig | StanzaRedirect RedirectConfig | StanzaWebApp WebAppConfig - | StanzaReverseProxy V04.ReverseProxyConfig + | StanzaReverseProxy ReverseProxyConfig instance ParseYamlFile Stanza where parseYamlFile basedir = withObject "Stanza" $ \o -> do diff --git a/Keter/ReverseProxy.hs b/Network/HTTP/ReverseProxy/Rewrite.hs similarity index 76% rename from Keter/ReverseProxy.hs rename to Network/HTTP/ReverseProxy/Rewrite.hs index 4642430..046eb54 100644 --- a/Keter/ReverseProxy.hs +++ b/Network/HTTP/ReverseProxy/Rewrite.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Keter.ReverseProxy +module Network.HTTP.ReverseProxy.Rewrite ( ReverseProxyConfig (..) , RewriteRule (..) , RPEntry (..) @@ -7,7 +7,7 @@ module Keter.ReverseProxy ) where -import Control.Applicative ((<|>)) +import Control.Applicative import Data.Monoid ((<>)) import qualified Data.Set as Set @@ -15,6 +15,7 @@ import Data.Set (Set) import qualified Data.Map as Map import Data.Map ( Map ) import Data.Array ((!)) +import Data.Aeson import qualified Data.ByteString as S import qualified Data.Text as T @@ -39,7 +40,6 @@ import Data.Conduit import qualified Network.Wai as Wai import Network.HTTP.Conduit import Network.HTTP.Types -import Keter.Types data RPEntry = RPEntry { config :: ReverseProxyConfig @@ -142,3 +142,48 @@ simpleReverseProxy (RPEntry { config = rpConfig, httpManager = mgr }) request = (mapOutput (Chunk . fromByteString) body) where respRuleMap = mkRuleMap $ rewriteResponseRules rpConfig + +data ReverseProxyConfig = ReverseProxyConfig + { reversedHost :: Text + , reversedPort :: Int + , reversingHost :: Text + , reverseUseSSL :: Bool + , reverseTimeout :: Maybe Int + , rewriteResponseRules :: Set RewriteRule + , rewriteRequestRules :: Set RewriteRule + } deriving (Eq, Ord) + +instance FromJSON ReverseProxyConfig where + parseJSON (Object o) = ReverseProxyConfig + <$> o .: "reversed-host" + <*> o .: "reversed-port" + <*> o .: "reversing-host" + <*> o .:? "ssl" .!= False + <*> o .:? "timeout" .!= Nothing + <*> o .:? "rewrite-response" .!= Set.empty + <*> o .:? "rewrite-request" .!= Set.empty + parseJSON _ = fail "Wanted an object" + +instance Default ReverseProxyConfig where + def = ReverseProxyConfig + { reversedHost = "" + , reversedPort = 80 + , reversingHost = "" + , reverseUseSSL = False + , reverseTimeout = Nothing + , rewriteResponseRules = Set.empty + , rewriteRequestRules = Set.empty + } + +data RewriteRule = RewriteRule + { ruleHeader :: Text + , ruleRegex :: Text + , ruleReplacement :: Text + } deriving (Eq, Ord) + +instance FromJSON RewriteRule where + parseJSON (Object o) = RewriteRule + <$> o .: "header" + <*> o .: "from" + <*> o .: "to" + parseJSON _ = fail "Wanted an object" diff --git a/keter.cabal b/keter.cabal index 7fef8a5..d5f09ca 100644 --- a/keter.cabal +++ b/keter.cabal @@ -72,7 +72,7 @@ Library Keter.Prelude Keter.Proxy Keter.HostManager - Keter.ReverseProxy + Network.HTTP.ReverseProxy.Rewrite Data.Yaml.FilePath Codec.Archive.TempTarball ghc-options: -Wall