keter 2.3.0 → 2.3.2
raw patch · 9 files changed
+232/−11 lines, 9 filesdep +temporarydep ~containersdep ~tlsdep ~tls-session-manager
Dependencies added: temporary
Dependency ranges changed: containers, tls, tls-session-manager, yaml
Files
- ChangeLog.md +15/−0
- README.md +15/−0
- keter.cabal +9/−4
- src/Keter/App.hs +7/−3
- src/Keter/Config/V10.hs +7/−0
- src/Keter/Rewrite.hs +8/−4
- test/Keter/Config/V10Spec.hs +58/−0
- test/Keter/RewriteSpec.hs +109/−0
- test/Spec.hs +4/−0
ChangeLog.md view
@@ -1,5 +1,20 @@ # Changelog +## 2.3.2++- Bump `tls` upper bound from `<2.2` to `<2.4` to allow tls 2.2.x and 2.3.x.+- Bump `tls-session-manager` to allow `^>=0.1.0` (needed for tls 2.3.x support).++## 2.3.1++- Add `port-env-vars` option for webapp stanzas. Allows specifying additional+ environment variable names (e.g., `YESOD_PORT`) that receive the same+ port value as `PORT`. This avoids the need to change app configuration+ when deploying with Keter.+- Add `preserve-host` option for reverse proxy stanzas. When set to `true`,+ preserves the original `Host` header when proxying requests.+ [299](https://github.com/snoyberg/keter/issues/299)+ ## 2.3.0 - Add integration with keter-rate-limiting-plugin. [301](https://github.com/snoyberg/keter/issues/301), thanks @Oleksandr-Zhabenko
README.md view
@@ -59,6 +59,21 @@ variable in `config/settings.yaml` from `YESOD_PORT` to `PORT` for compatibility with Keter. + Alternatively, you can use `port-env-vars` in your `config/keter.yaml` to+ have Keter set the port under additional environment variable names:++ ```yaml+ stanzas:+ - type: webapp+ exec: ../dist/bin/myapp+ host: www.example.com+ port-env-vars:+ - YESOD_PORT+ ```++ With this configuration, both `PORT` and `YESOD_PORT` will be set to+ the same Keter-assigned port, so you don't need to modify your app.+ 2. Create a file `config/keter.yaml`. The minimal file just has two settings: ```yaml
keter.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: keter-version: 2.3.0+version: 2.3.2 synopsis: Web application deployment manager, focusing on Haskell web frameworks. It mitigates downtime. @@ -62,8 +62,8 @@ , template-haskell >=2.17.0 && <3.0 , text >=1.2.5 && <3.0 , time >=1.9.3 && <2.0- , tls >=1.5.7 && <2.2- , tls-session-manager >=0.0.4 && <0.1+ , tls >=1.5.7 && <2.4+ , tls-session-manager >=0.0.4 && <0.1 || ^>=0.1.0 , transformers >=0.5.6 && <0.7 , unix >=2.7.2 && <2.9 , unix-compat >=0.3 && <0.8@@ -132,12 +132,15 @@ hs-source-dirs: test default-extensions: ImportQualifiedPost main-is: Spec.hs- other-modules: Keter.Proxy.MiddlewareSpec+ other-modules: Keter.Config.V10Spec+ , Keter.Proxy.MiddlewareSpec+ , Keter.RewriteSpec type: exitcode-stdio-1.0 build-depends: , aeson , base , bytestring+ , containers , conduit , http-client , http-conduit@@ -151,6 +154,7 @@ , stm , tasty , tasty-hunit+ , temporary , tls , transformers , unix@@ -158,6 +162,7 @@ , wai , warp , wreq+ , yaml ghc-options: -Wall -threaded
src/Keter/App.hs view
@@ -294,6 +294,7 @@ if waconfigSsl == SSLFalse then ("http://", if httpPort == 80 then "" else ':' : show httpPort) else ("https://", if httpsPort == 443 then "" else ':' : show httpsPort)+ portText = pack $ show waconfigPort env = Map.toList $ Map.unions -- Ordering chosen specifically to precedence rules: app specific, -- plugins, global, and then auto-set Keter variables.@@ -301,7 +302,7 @@ , forwardedEnv , Map.fromList otherEnv , kconfigEnvironment ascKeterConfig- , Map.singleton "PORT" $ pack $ show waconfigPort+ , Map.fromList $ map (, portText) ("PORT" : Set.toList waconfigPortEnvVars) , Map.singleton "APPROOT" $ scheme <> CI.original waconfigApprootHost <> pack extport ] exec <- liftIO $ canonicalizePath waconfigExec@@ -327,11 +328,13 @@ AIBuiltin -> "__builtin__" AINamed x -> x -killWebApp :: RunningWebApp -> KeterM cfg ()+killWebApp :: RunningWebApp -> KeterM AppStartConfig () killWebApp RunningWebApp {..} = do+ AppStartConfig{..} <- ask status <- liftIO $ printStatus rwaProcess $logInfo $ pack $ "Killing " <> unpack status <> " running on port: " <> show rwaPort liftIO $ terminateMonitoredProcess rwaProcess+ liftIO $ releasePort ascPortPool rwaPort ensureAlive :: TVar AppState -> RunningWebApp -> IO () ensureAlive tstate RunningWebApp {..} = do@@ -341,7 +344,8 @@ else error $ "ensureAlive failed, this means keter couldn't " <> "detect your app at port " <> show rwaPort <> ", check your app logs detailed errors. " <>- " Also make sure your app binds to the PORT environment variable (not YESOD_PORT for example)." -- TODO domain name would be good to add as well+ " Also make sure your app binds to the PORT environment variable" <>+ " (or use port-env-vars in keter.yaml to set additional env var names like YESOD_PORT)." where testApp :: Port -> IO Bool testApp port = do
src/Keter/Config/V10.hs view
@@ -427,6 +427,10 @@ -- | stanza-local WAI middlewares applied by Keter (e.g., rate limiter). -- Parsed from YAML key "middleware". Default: []. , waconfigMiddleware :: ![ MiddlewareConfig ]+ -- | Extra environment variable names that should also receive the+ -- assigned port value (in addition to @PORT@).+ -- Parsed from YAML key "port-env-vars". Default: empty.+ , waconfigPortEnvVars :: !(Set Text) } deriving Show @@ -444,6 +448,7 @@ , waconfigTimeout = Nothing , waconfigEnsureAliveTimeout = Nothing , waconfigMiddleware = []+ , waconfigPortEnvVars = Set.empty } instance ParseYamlFile (WebAppConfig ()) where@@ -469,6 +474,7 @@ <*> o .:? "connection-time-bound" <*> o .:? "ensure-alive-time-bound" <*> o .:? "middleware" .!= []+ <*> o .:? "port-env-vars" .!= Set.empty instance ToJSON (WebAppConfig ()) where toJSON WebAppConfig {..} = object@@ -481,6 +487,7 @@ , "connection-time-bound" .= waconfigTimeout , "ensure-alive-time-bound" .= waconfigEnsureAliveTimeout , "middleware" .= waconfigMiddleware+ , "port-env-vars" .= waconfigPortEnvVars ] data AppInput = AIBundle !FilePath !EpochTime
src/Keter/Rewrite.hs view
@@ -6,6 +6,7 @@ , RewriteRule (..) , RPEntry (..) , simpleReverseProxy+ , filterHeaders ) where @@ -94,12 +95,12 @@ strInput = T.unpack . decodeUtf8 $ input strReplacement = T.unpack replacement -filterHeaders :: [Header] -> [Header]-filterHeaders = filter useHeader+filterHeaders :: Bool -> [Header] -> [Header]+filterHeaders preserveHost = filter useHeader where useHeader ("Transfer-Encoding", _) = False useHeader ("Content-Length", _) = False- useHeader ("Host", _) = False+ useHeader ("Host", _) = preserveHost useHeader _ = True mkRuleMap :: Set RewriteRule -> Map HeaderName RewriteRule@@ -116,7 +117,7 @@ , port = reversedPort rpConfig , path = Wai.rawPathInfo request , queryString = Wai.rawQueryString request- , requestHeaders = filterHeaders $ rewriteHeaders reqRuleMap (Wai.requestHeaders request)+ , requestHeaders = filterHeaders (reversePreserveHost rpConfig) $ rewriteHeaders reqRuleMap (Wai.requestHeaders request) , requestBody = case Wai.requestBodyLength request of Wai.ChunkedBody -> RequestBodyStreamChunked ($ I.getRequestBodyChunk request)@@ -155,6 +156,7 @@ , reverseTimeout :: Maybe Int , rewriteResponseRules :: Set RewriteRule , rewriteRequestRules :: Set RewriteRule+ , reversePreserveHost :: Bool } deriving (Eq, Ord, Show) instance FromJSON ReverseProxyConfig where@@ -167,6 +169,7 @@ <*> o .:? "timeout" .!= Nothing <*> o .:? "rewrite-response" .!= Set.empty <*> o .:? "rewrite-request" .!= Set.empty+ <*> o .:? "preserve-host" .!= False parseJSON _ = fail "Wanted an object" instance ToJSON ReverseProxyConfig where@@ -179,6 +182,7 @@ , "timeout" .= reverseTimeout , "rewrite-response" .= rewriteResponseRules , "rewrite-request" .= rewriteRequestRules+ , "preserve-host" .= reversePreserveHost ] data RewriteRule = RewriteRule
+ test/Keter/Config/V10Spec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Keter.Config.V10Spec (tests) where++import Data.ByteString.Char8 qualified as BS+import Data.Set qualified as Set+import Keter.Config.V10+import Keter.Yaml.FilePath (decodeFileRelative)+import System.IO (hClose)+import System.IO.Temp (withSystemTempFile)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "Keter.Config.V10 (WebAppConfig parsing)"+ [ testCase "port-env-vars parses a list of variable names" casePortEnvVarsList+ , testCase "port-env-vars defaults to empty when omitted" casePortEnvVarsDefault+ , testCase "port-env-vars parses empty list" casePortEnvVarsEmpty+ ]++-- | Helper: write YAML bytes to a temp file, then parse as a 'WebAppConfig'.+parseWebAppConfig :: BS.ByteString -> IO (WebAppConfig ())+parseWebAppConfig yaml =+ withSystemTempFile "keter-test-.yaml" $ \fp h -> do+ BS.hPut h yaml+ hClose h+ result <- decodeFileRelative fp+ case result of+ Left err -> assertFailure ("Failed to parse: " <> show err) >> error "unreachable"+ Right wac -> return wac++casePortEnvVarsList :: IO ()+casePortEnvVarsList = do+ wac <- parseWebAppConfig $ BS.unlines+ [ "exec: /tmp/myapp"+ , "host: example.com"+ , "port-env-vars:"+ , " - YESOD_PORT"+ , " - RAILS_PORT"+ ]+ waconfigPortEnvVars wac @?= Set.fromList ["YESOD_PORT", "RAILS_PORT"]++casePortEnvVarsDefault :: IO ()+casePortEnvVarsDefault = do+ wac <- parseWebAppConfig $ BS.unlines+ [ "exec: /tmp/myapp"+ , "host: example.com"+ ]+ waconfigPortEnvVars wac @?= Set.empty++casePortEnvVarsEmpty :: IO ()+casePortEnvVarsEmpty = do+ wac <- parseWebAppConfig $ BS.unlines+ [ "exec: /tmp/myapp"+ , "host: example.com"+ , "port-env-vars: []"+ ]+ waconfigPortEnvVars wac @?= Set.empty
+ test/Keter/RewriteSpec.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++module Keter.RewriteSpec (tests) where++import Data.Aeson (eitherDecodeStrict)+import Data.ByteString.Char8 qualified as BS+import Test.Tasty+import Test.Tasty.HUnit+import Keter.Rewrite++tests :: TestTree+tests = testGroup "Keter.Rewrite"+ [ testGroup "ReverseProxyConfig parsing"+ [ testCase "preserve-host defaults to False when omitted" casePreserveHostDefault+ , testCase "preserve-host parses True" casePreserveHostTrue+ , testCase "preserve-host parses False explicitly" casePreserveHostFalse+ ]+ , testGroup "filterHeaders"+ [ testCase "strips Host header when preserveHost is False" caseFilterHeadersStripsHost+ , testCase "preserves Host header when preserveHost is True" caseFilterHeadersPreservesHost+ , testCase "always strips Transfer-Encoding" caseFilterHeadersStripsTransferEncoding+ , testCase "always strips Content-Length" caseFilterHeadersStripsContentLength+ , testCase "preserves other headers" caseFilterHeadersPreservesOthers+ ]+ ]++-- | Helper to parse ReverseProxyConfig from JSON/YAML bytes+parseReverseProxyConfig :: BS.ByteString -> Either String ReverseProxyConfig+parseReverseProxyConfig = eitherDecodeStrict++-- Config parsing tests++casePreserveHostDefault :: IO ()+casePreserveHostDefault = do+ let json = BS.unlines+ [ "{"+ , " \"reversed-host\": \"localhost\","+ , " \"reversed-port\": 3000,"+ , " \"reversed-ssl\": false,"+ , " \"reversing-host\": \"example.com\""+ , "}"+ ]+ case parseReverseProxyConfig json of+ Left err -> assertFailure ("Failed to parse: " <> err)+ Right cfg -> reversePreserveHost cfg @?= False++casePreserveHostTrue :: IO ()+casePreserveHostTrue = do+ let json = BS.unlines+ [ "{"+ , " \"reversed-host\": \"localhost\","+ , " \"reversed-port\": 3000,"+ , " \"reversed-ssl\": false,"+ , " \"reversing-host\": \"example.com\","+ , " \"preserve-host\": true"+ , "}"+ ]+ case parseReverseProxyConfig json of+ Left err -> assertFailure ("Failed to parse: " <> err)+ Right cfg -> reversePreserveHost cfg @?= True++casePreserveHostFalse :: IO ()+casePreserveHostFalse = do+ let json = BS.unlines+ [ "{"+ , " \"reversed-host\": \"localhost\","+ , " \"reversed-port\": 3000,"+ , " \"reversed-ssl\": false,"+ , " \"reversing-host\": \"example.com\","+ , " \"preserve-host\": false"+ , "}"+ ]+ case parseReverseProxyConfig json of+ Left err -> assertFailure ("Failed to parse: " <> err)+ Right cfg -> reversePreserveHost cfg @?= False++-- filterHeaders tests++caseFilterHeadersStripsHost :: IO ()+caseFilterHeadersStripsHost = do+ let headers = [("Host", "example.com"), ("Accept", "text/html")]+ result = filterHeaders False headers+ result @?= [("Accept", "text/html")]++caseFilterHeadersPreservesHost :: IO ()+caseFilterHeadersPreservesHost = do+ let headers = [("Host", "example.com"), ("Accept", "text/html")]+ result = filterHeaders True headers+ result @?= [("Host", "example.com"), ("Accept", "text/html")]++caseFilterHeadersStripsTransferEncoding :: IO ()+caseFilterHeadersStripsTransferEncoding = do+ let headers = [("Transfer-Encoding", "chunked"), ("Accept", "text/html")]+ -- Should be stripped regardless of preserveHost+ filterHeaders False headers @?= [("Accept", "text/html")]+ filterHeaders True headers @?= [("Accept", "text/html")]++caseFilterHeadersStripsContentLength :: IO ()+caseFilterHeadersStripsContentLength = do+ let headers = [("Content-Length", "123"), ("Accept", "text/html")]+ -- Should be stripped regardless of preserveHost+ filterHeaders False headers @?= [("Accept", "text/html")]+ filterHeaders True headers @?= [("Accept", "text/html")]++caseFilterHeadersPreservesOthers :: IO ()+caseFilterHeadersPreservesOthers = do+ let headers = [("Accept", "text/html"), ("User-Agent", "test"), ("X-Custom", "value")]+ result = filterHeaders False headers+ result @?= headers
test/Spec.hs view
@@ -23,7 +23,9 @@ import Network.Wreq qualified as Wreq import Test.Tasty import Test.Tasty.HUnit+import qualified Keter.Config.V10Spec as V10 import qualified Keter.Proxy.MiddlewareSpec as ProxyMW+import qualified Keter.RewriteSpec as Rewrite main :: IO () main = defaultMain keterTests@@ -36,6 +38,8 @@ , testCase "Wildcard Domains" caseWildcards , testCase "Head then post doesn't crash" headThenPostNoCrash , ProxyMW.tests+ , V10.tests+ , Rewrite.tests ] caseSubdomainIntegrity :: IO ()