keter 1.3.2 → 1.3.3

raw patch · 3 files changed

+29/−32 lines, 3 filesdep ~stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: stm

API changes (from Hackage documentation)

Files

• Keter/Proxy.hs +20/−15
• Keter/Types/V10.hs +5/−15
• keter.cabal +4/−2

@@ -41,9 +41,10 @@ -- | Mapping from virtual hostname to port number. type HostLookup = ByteString -> IO (Maybe ProxyAction) -reverseProxy :: Bool -> Manager -> HostLookup -> ListeningPort -> IO ()+reverseProxy :: Bool+             -> Manager -> HostLookup -> ListeningPort -> IO () reverseProxy useHeader manager hostLookup listener =-    run $ gzip def $ withClient useHeader manager hostLookup+    run $ gzip def $ withClient useHeader protocol manager hostLookup   where     warp host port = Warp.setHost host $ Warp.setPort port Warp.defaultSettings     run =@@ -52,12 +53,17 @@             LPSecure host port cert key -> WarpTLS.runTLS                 (WarpTLS.tlsSettings (F.encodeString cert) (F.encodeString key))                 (warp host port)+    protocol =+        case listener of+            LPInsecure _ _ -> "http"+            LPSecure _ _ _ _ -> "https"  withClient :: Bool -- ^ use incoming request header for IP address+           -> ByteString -- ^ protocol, for X-Forwarded-Proto            -> Manager            -> HostLookup            -> Wai.Application-withClient useHeader manager portLookup req0 sendResponse =+withClient useHeader protocol manager portLookup req0 sendResponse =     timeBound (5 * 60 * 1000 * 1000) (waiProxyToSettings getDest def         { wpsSetIpHeader =             if useHeader@@ -80,7 +86,7 @@      getDest :: Wai.Request -> IO WaiProxyResponse     getDest req =-        case lookup "host" $ Wai.requestHeaders req of+        case Wai.requestHeaderHost req of             Nothing -> return $ WPRResponse missingHostResponse             Just host -> processHost req host @@ -91,8 +97,13 @@             Nothing -> return $ WPRResponse $ unknownHostResponse host             Just action -> performAction req action -    performAction _ (PAPort port) =-        return $ WPRProxyDest $ ProxyDest "127.0.0.1" port+    performAction req (PAPort port) =+        return $ WPRModifiedRequest req' $ ProxyDest "127.0.0.1" port+      where+        req' = req+            { Wai.requestHeaders = ("X-Forwarded-Proto", protocol)+                                 : Wai.requestHeaders req+            }     performAction _ (PAStatic StaticFilesConfig {..}) = do         return $ WPRApplication $ staticApp (defaultFileServerSettings sfconfigRoot)             { ssListing =@@ -107,16 +118,10 @@ redirectApp RedirectConfig {..} req =     V.foldr checkAction noAction redirconfigActions   where-    checkAction (RedirectAction SPAny dest msecure) other-        | checkSecure msecure req = sendTo $ mkUrl dest-        | otherwise = other-    checkAction (RedirectAction (SPSpecific path) dest msecure) other-        | encodeUtf8 path == Wai.rawPathInfo req && checkSecure msecure req =-            sendTo $ mkUrl dest+    checkAction (RedirectAction SPAny dest) _ = sendTo $ mkUrl dest+    checkAction (RedirectAction (SPSpecific path) dest) other+        | encodeUtf8 path == Wai.rawPathInfo req = sendTo $ mkUrl dest         | otherwise = other--    checkSecure Nothing _ = True-    checkSecure (Just needsSecure) req = needsSecure == Wai.isSecure req      noAction = Wai.responseBuilder         status404

@@ -221,7 +221,7 @@         { redirconfigHosts = Set.singleton from         , redirconfigStatus = 301         , redirconfigActions = V.singleton $ RedirectAction SPAny-                             (RDPrefix False to Nothing) Nothing+                             $ RDPrefix False to Nothing         }  instance ParseYamlFile RedirectConfig where@@ -237,32 +237,22 @@         , "actions" .= redirconfigActions         ] -data RedirectAction = RedirectAction-    { raSourcePath :: !SourcePath-    , raRedirectDest :: !RedirectDest-    , raSourceSecure :: !(Maybe Bool)-    }+data RedirectAction = RedirectAction !SourcePath !RedirectDest     deriving Show  instance FromJSON RedirectAction where     parseJSON = withObject "RedirectAction" $ \o -> RedirectAction         <$> (maybe SPAny SPSpecific <$> (o .:? "path"))         <*> parseJSON (Object o)-        <*> o .:? "secure"  instance ToJSON RedirectAction where-    toJSON (RedirectAction path dest sourceSecure) =+    toJSON (RedirectAction path dest) =         case toJSON dest of             Object o ->                 case path of-                    SPAny -> Object $ addSecureSource o-                    SPSpecific x -> Object $ addSecureSource $ HashMap.insert "path" (String x) o+                    SPAny -> Object o+                    SPSpecific x -> Object $ HashMap.insert "path" (String x) o             v -> v-      where-        addSecureSource =-            case sourceSecure of-                Nothing -> id-                Just b -> HashMap.insert "secure" (Bool b)  data SourcePath = SPAny                 | SPSpecific !Text

@@ -1,11 +1,13 @@ Name:                keter-Version:             1.3.2+Version:             1.3.3 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>     .     Release history:     .+    [1.3.3] Set the X-Forwarded-Proto header+    .     [1.3.2] Enable GZIP middleware     .     [1.3.1] Upgrade to WAI 3.0@@ -75,7 +77,7 @@                      , aeson                      , unordered-containers                      , vector-                     , stm+                     , stm                       >= 2.4                      , async                      , lifted-base   Exposed-Modules:     Keter.Plugin.Postgres