Add per bundle certificates for static files and redirects.

Keter/App.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TupleSections       #-}
 module Keter.App
     ( App
     , AppStartConfig (..)
@@ -132,46 +133,45 @@ withReservations asc aid bconfig f = withActions asc bconfig $ \wacs backs actio
 
 withActions :: AppStartConfig
             -> BundleConfig
-            -> ([WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a)
+            -> ([ WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a)
             -> IO a
 withActions asc bconfig f =
     loop (V.toList $ bconfigStanzas bconfig) [] [] Map.empty
   where
+    -- todo: add loading from relative location
+    loadCert (SSL certFile chainCertFiles keyFile) =
+         either (const mempty) (TLS.Credentials . (:[]))
+            <$> TLS.credentialLoadX509Chain certFile (V.toList chainCertFiles) keyFile
+    loadCert _ = return mempty
+
     loop [] wacs backs actions = f wacs backs actions
     loop (Stanza (StanzaWebApp wac) rs:stanzas) wacs backs actions = bracketOnError
-        (
-           getPort (ascLog asc) (ascPortPool asc) >>= either throwIO
-             (\p -> do
-                c <- case waconfigSsl wac of
-                       -- todo: add loading from relative location
-                       SSL certFile chainCertFiles keyFile ->
-                              either (const mempty) (TLS.Credentials . (:[])) <$>
-                                  TLS.credentialLoadX509Chain certFile (V.toList chainCertFiles) keyFile
-                       _ -> return mempty
-                return (p, c)
-             )
+        (getPort (ascLog asc) (ascPortPool asc) >>= either throwIO
+             (\p -> fmap (p,) <$> loadCert $ waconfigSsl wac)
         )
-        (\(port, cert) -> releasePort (ascPortPool asc) port)
+        (\(port, _)    -> releasePort (ascPortPool asc) port)
         (\(port, cert) -> loop
             stanzas
             (wac { waconfigPort = port } : wacs)
             backs
             (Map.unions $ actions : map (\host -> Map.singleton host ((PAPort port (waconfigTimeout wac), rs), cert)) hosts))
       where
         hosts = Set.toList $ Set.insert (waconfigApprootHost wac) (waconfigHosts wac)
-    loop (Stanza (StanzaStaticFiles sfc) rs:stanzas) wacs backs actions0 =
-        loop stanzas wacs backs actions
+    loop (Stanza (StanzaStaticFiles sfc) rs:stanzas) wacs backs actions0 = do
+        cert <- loadCert $ sfconfigSsl sfc
+        loop stanzas wacs backs (actions cert)
       where
-        actions = Map.unions
+        actions cert = Map.unions
                 $ actions0
-                : map (\host -> Map.singleton host ((PAStatic sfc, rs), mempty))
+                : map (\host -> Map.singleton host ((PAStatic sfc, rs), cert))
                   (Set.toList (sfconfigHosts sfc))
-    loop (Stanza (StanzaRedirect red) rs:stanzas) wacs backs actions0 =
-        loop stanzas wacs backs actions
+    loop (Stanza (StanzaRedirect red) rs:stanzas) wacs backs actions0 = do
+        cert <- loadCert $ redirconfigSsl red
+        loop stanzas wacs backs (actions cert)
       where
-        actions = Map.unions
+        actions cert = Map.unions
                 $ actions0
-                : map (\host -> Map.singleton host ((PARedirect red, rs), mempty))
+                : map (\host -> Map.singleton host ((PARedirect red, rs), cert))
                   (Set.toList (redirconfigHosts red))
     loop (Stanza (StanzaReverseProxy rev mid to) rs:stanzas) wacs backs actions0 =
         loop stanzas wacs backs actions

Keter/Proxy.hs

@@ -146,6 +146,7 @@ withClient isSecure useHeader bound manager hostLookup =
             , redirconfigStatus = 301
             , redirconfigActions = V.singleton $ RedirectAction SPAny
                                  $ RDPrefix True host' Nothing
+            , redirconfigSsl = SSLTrue
             }
 
     performAction req (PAPort port tbound) =

Keter/Types/V10.hs

@@ -235,6 +235,7 @@ data StaticFilesConfig = StaticFilesConfig
     -- FIXME basic auth
     , sfconfigMiddleware :: ![ MiddlewareConfig ]
     , sfconfigTimeout    :: !(Maybe Int)
+    , sfconfigSsl        :: !SSLConfig
     }
     deriving Show
 
@@ -246,6 +247,7 @@ instance ToCurrent StaticFilesConfig where
         , sfconfigListings   = True
         , sfconfigMiddleware = []
         , sfconfigTimeout    = Nothing
+        , sfconfigSsl        = SSLFalse
         }
 
 instance ParseYamlFile StaticFilesConfig where
@@ -255,6 +257,7 @@ instance ParseYamlFile StaticFilesConfig where
         <*> o .:? "directory-listing" .!= False
         <*> o .:? "middleware" .!= []
         <*> o .:? "connection-time-bound"
+        <*> o .:? "ssl" .!= SSLFalse
 
 instance ToJSON StaticFilesConfig where
     toJSON StaticFilesConfig {..} = object
@@ -263,12 +266,14 @@ instance ToJSON StaticFilesConfig where
         , "directory-listing" .= sfconfigListings
         , "middleware" .= sfconfigMiddleware
         , "connection-time-bound" .= sfconfigTimeout
+        , "ssl" .= sfconfigSsl
         ]
 
 data RedirectConfig = RedirectConfig
     { redirconfigHosts   :: !(Set Host)
     , redirconfigStatus  :: !Int
     , redirconfigActions :: !(Vector RedirectAction)
+    , redirconfigSsl     :: !SSLConfig
     }
     deriving Show
 
@@ -279,19 +284,22 @@ instance ToCurrent RedirectConfig where
         , redirconfigStatus = 301
         , redirconfigActions = V.singleton $ RedirectAction SPAny
                              $ RDPrefix False (CI.mk to) Nothing
+        , redirconfigSsl = SSLFalse
         }
 
 instance ParseYamlFile RedirectConfig where
     parseYamlFile _ = withObject "RedirectConfig" $ \o -> RedirectConfig
         <$> (Set.map CI.mk <$> ((o .: "hosts" <|> (Set.singleton <$> (o .: "host")))))
         <*> o .:? "status" .!= 303
         <*> o .: "actions"
+        <*> o .:? "ssl" .!= SSLFalse
 
 instance ToJSON RedirectConfig where
     toJSON RedirectConfig {..} = object
         [ "hosts" .= Set.map CI.original redirconfigHosts
         , "status" .= redirconfigStatus
         , "actions" .= redirconfigActions
+        , "ssl" .= redirconfigSsl
         ]
 
 data RedirectAction = RedirectAction !SourcePath !RedirectDest

stack.yaml

@@ -3,4 +3,4 @@ flags:
 packages:
 - '.'
 extra-deps: []
-resolver: lts-5.0
+resolver: lts-7.19