Extract reverse proxy rewrite rules

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 ()

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

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
 

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 (..))

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"

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

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"

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