Significant refactoring of Keter.App

Keter/App.hs

@@ -1,54 +1,59 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell     #-}
 module Keter.App
     ( App
     , AppStartConfig (..)
-    , AppId (..)
-    , AppInput (..)
     , start
     , reload
     , getTimestamp
     , Keter.App.terminate
     ) where
 
-import           System.Posix.Types      (EpochTime)
-import Control.Concurrent.STM (STM)
-import Codec.Archive.TempTarball
-import Keter.Types
-import Keter.HostManager hiding (start)
+import           Codec.Archive.TempTarball
+import           Control.Applicative       ((<$>))
+import           Control.Arrow             ((***))
+import           Control.Concurrent.STM
+import           Control.Exception         (bracketOnError, throwIO)
+import qualified Data.Conduit.LogFile      as LogFile
+import           Data.Conduit.Process.Unix (MonitoredProcess, ProcessTracker,
+                                            RotatingLog, monitorProcess,
+                                            terminateMonitoredProcess)
+import qualified Data.Map                  as Map
+import           Data.Monoid               ((<>))
+import qualified Data.Set                  as Set
+import           Data.Text                 (pack)
+import           Data.Text.Encoding        (decodeUtf8With, encodeUtf8)
+import           Data.Text.Encoding.Error  (lenientDecode)
+import qualified Data.Vector               as V
+import           Data.Yaml
+import           Data.Yaml.FilePath
+import           Filesystem                (removeTree)
 import qualified Filesystem.Path.CurrentOS as F
-import qualified Filesystem as F
-import Data.Yaml
-import Control.Applicative ((<$>))
-import qualified Network
-import Data.Maybe (fromMaybe)
-import Control.Exception (throwIO, try, IOException)
-import System.IO (hClose)
-import qualified Data.Set as Set
-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
-import Data.Text.Encoding.Error (lenientDecode)
-import System.Posix.Types (UserID, GroupID)
-import Data.Conduit.Process.Unix (ProcessTracker, RotatingLog, terminateMonitoredProcess, monitorProcess)
-import Data.Yaml.FilePath
-import Keter.PortPool (PortPool)
-import Control.Concurrent (threadDelay)
-import System.Timeout (timeout)
-import Prelude hiding (FilePath)
+import           Keter.HostManager         hiding (start)
+import           Keter.PortPool            (PortPool, getPort, releasePort)
+import           Keter.Types
+import           Prelude                   hiding (FilePath)
+import           System.Posix.Types        (EpochTime)
+import           System.Posix.Types        (GroupID, UserID)
 
-data Command = Reload | Terminate
-newtype App = App (Command -> IO ())
+data App = App
+    { appModTime        :: !(TVar (Maybe EpochTime))
+    , appRunningWebApps :: ![RunningWebApp]
+    }
 
-unpackBundle :: (LogMessage -> IO ())
-             -> TempFolder
-             -> Maybe (UserID, GroupID)
+data RunningWebApp = RunningWebApp
+    { rwaProcess :: !MonitoredProcess
+    }
+
+unpackBundle :: AppStartConfig
              -> FilePath
-             -> Appname
+             -> AppId
              -> IO (FilePath, BundleConfig)
-unpackBundle log tf muid bundle appname = do
-    log $ UnpackingBundle bundle
-    unpackTempTar muid tf bundle appname $ \dir -> do
+unpackBundle AppStartConfig {..} bundle aid = do
+    ascLog $ UnpackingBundle bundle
+    unpackTempTar (fmap snd ascSetuid) ascTempFolder bundle folderName $ \dir -> do
         let configFP = dir F.</> "config" F.</> "keter.yaml"
         mconfig <- decodeFileRelative configFP
         config <-
@@ -56,27 +61,181 @@ unpackBundle log tf muid bundle appname = do
                 Right config -> return config
                 Left e -> throwIO $ InvalidConfigFile e
         return (dir, config)
+  where
+    folderName =
+        case aid of
+            AIBuiltin -> "__builtin__"
+            AINamed x -> x
 
 data AppStartConfig = AppStartConfig
-    { ascTempFolder :: !TempFolder
-    , ascSetuid :: !(Maybe (Text, (UserID, GroupID)))
+    { ascTempFolder     :: !TempFolder
+    , ascSetuid         :: !(Maybe (Text, (UserID, GroupID)))
     , ascProcessTracker :: !ProcessTracker
-    , ascHostManager :: !HostManager
-    , ascPortPool :: !PortPool
-    , ascPlugins :: !Plugins
+    , ascHostManager    :: !HostManager
+    , ascPortPool       :: !PortPool
+    , ascPlugins        :: !Plugins
+    , ascLog            :: !(LogMessage -> IO ())
+    , ascKeterConfig    :: !KeterConfig
     }
 
-data AppInput = AIBundle !FilePath !EpochTime
-              | AIData !BundleConfig
+withConfig :: AppStartConfig
+           -> AppId
+           -> AppInput
+           -> (FilePath -> BundleConfig -> Maybe EpochTime -> IO a)
+           -> IO a
+withConfig _asc _aid (AIData bconfig) f = f "/tmp" bconfig Nothing
+withConfig asc aid (AIBundle fp modtime) f = bracketOnError
+    (unpackBundle asc fp aid)
+    (\(newdir, _) -> removeTree newdir)
+    $ \(newdir, bconfig) -> f newdir bconfig (Just modtime)
 
-data AppId = AIBuiltin | AINamed !Appname
-    deriving (Eq, Ord)
+withReservations :: AppStartConfig
+                 -> AppId
+                 -> BundleConfig
+                 -> ([WebAppConfig Port] -> Map Host ProxyAction -> IO a)
+                 -> IO a
+withReservations asc aid bconfig f = withActions asc bconfig $ \wacs actions -> bracketOnError
+    (reserveHosts (ascHostManager asc) aid $ Map.keysSet actions)
+    (forgetReservations (ascHostManager asc) aid)
+    (const $ f wacs actions)
+
+withActions :: AppStartConfig
+            -> BundleConfig
+            -> ([WebAppConfig Port] -> Map Host ProxyAction -> IO a)
+            -> IO a
+withActions asc bconfig f =
+    loop (V.toList $ bconfigStanzas bconfig) [] Map.empty
+  where
+    loop [] wacs actions = f wacs actions
+    loop (StanzaWebApp wac:stanzas) wacs actions = bracketOnError
+        (getPort (ascLog asc) (ascPortPool asc) >>= either throwIO return)
+        (releasePort (ascPortPool asc))
+        (\port -> loop
+            stanzas
+            (wac { waconfigPort = port } : wacs)
+            (Map.unions $ actions : map (\host -> Map.singleton host $ PAPort port) hosts))
+      where
+        hosts = Set.toList $ Set.insert (waconfigApprootHost wac) (waconfigHosts wac)
+    loop (StanzaStaticFiles sfc:stanzas) wacs actions0 =
+        loop stanzas wacs actions
+      where
+        actions = Map.unions
+                $ actions0
+                : map (\host -> Map.singleton host $ PAStatic sfc)
+                  (Set.toList (sfconfigHosts sfc))
+    loop (StanzaRedirect red:stanzas) wacs actions0 =
+        loop stanzas wacs actions
+      where
+        actions = Map.unions
+                $ actions0
+                : map (\host -> Map.singleton host $ PARedirect red)
+                  (Set.toList (redirconfigHosts red))
+    loop (StanzaReverseProxy rev:stanzas) wacs actions0 =
+        loop stanzas wacs actions
+      where
+        actions = Map.insert (reversingHost rev) (PAReverseProxy rev) actions0
+
+withRotatingLog :: AppStartConfig
+                -> AppId
+                -> (RotatingLog -> IO a)
+                -> IO a
+withRotatingLog AppStartConfig {..} aid = bracketOnError
+    (LogFile.openRotatingLog (F.encodeString dir) LogFile.defaultMaxTotal)
+    LogFile.close
+  where
+    dir = kconfigDir ascKeterConfig F.</> "log" F.</> name
+    name =
+        case aid of
+            AIBuiltin -> "__builtin__"
+            AINamed x -> F.fromText $ "app-" <> x
 
 start :: AppStartConfig
       -> AppId
-      -> AppInput -- ^ if not provided, we'll extract from the relevant file
+      -> AppInput
       -> IO App
-start _ _ _ = error "Keter.App.start"
+start asc aid input =
+    withConfig asc aid input $ \newdir bconfig mmodtime ->
+    withReservations asc aid bconfig $ \webapps actions ->
+    withRotatingLog asc aid $ \rlog ->
+    withWebApps asc aid bconfig newdir rlog webapps $ \runningWebapps -> do
+        mapM_ ensureAlive runningWebapps
+        activateApp (ascHostManager asc) aid actions
+        tmodtime <- newTVarIO mmodtime
+        return App
+            { appModTime = tmodtime
+            , appRunningWebApps = runningWebapps
+            }
+
+withWebApps :: AppStartConfig
+            -> AppId
+            -> BundleConfig
+            -> FilePath
+            -> RotatingLog
+            -> [WebAppConfig Port]
+            -> ([RunningWebApp] -> IO a)
+            -> IO a
+withWebApps asc aid bconfig dir rlog configs0 f =
+    loop configs0 id
+  where
+    loop [] front = f $ front []
+    loop (c:cs) front = bracketOnError
+        (launchWebApp asc aid bconfig dir rlog c)
+        killWebApp
+        (\rwa -> loop cs (front . (rwa:)))
+
+launchWebApp :: AppStartConfig
+             -> AppId
+             -> BundleConfig
+             -> FilePath
+             -> RotatingLog
+             -> WebAppConfig Port
+             -> IO RunningWebApp
+launchWebApp AppStartConfig {..} aid BundleConfig {..} dir rlog WebAppConfig {..} = do
+    otherEnv <- pluginsGetEnv ascPlugins name bconfigRaw
+    let env = ("PORT", pack $ show waconfigPort)
+            : ("APPROOT", (if waconfigSsl then "https://" else "http://") <> waconfigApprootHost)
+            : otherEnv
+    bracketOnError
+        (monitorProcess
+            (ascLog . OtherMessage . decodeUtf8With lenientDecode)
+            ascProcessTracker
+            (encodeUtf8 . fst <$> ascSetuid)
+            (encodeUtf8 $ either id id $ F.toText waconfigExec)
+            (encodeUtf8 $ either id id $ F.toText dir)
+            (map encodeUtf8 $ V.toList waconfigArgs)
+            (map (encodeUtf8 *** encodeUtf8) env)
+            rlog)
+        terminateMonitoredProcess
+        $ \mp -> do
+            return RunningWebApp
+                { rwaProcess = mp
+                }
+  where
+    name =
+        case aid of
+            AIBuiltin -> "__builtin__"
+            AINamed x -> x
+
+killWebApp :: RunningWebApp -> IO ()
+killWebApp = error "killWebApp"
+
+ensureAlive :: RunningWebApp -> IO ()
+ensureAlive = error "ensureAlive"
+{-
+testApp :: Port -> IO Bool
+testApp port = do
+    res <- timeout (90 * 1000 * 1000) testApp'
+    return $ fromMaybe False res
+  where
+    testApp' = do
+        threadDelay $ 2 * 1000 * 1000
+        eres <- try $ Network.connectTo "127.0.0.1" $ Network.PortNumber $ fromIntegral port
+        case eres of
+            Left (_ :: IOException) -> testApp'
+            Right handle -> do
+                hClose handle
+                return True
+-}
 
     {-
 start :: TempFolder
@@ -94,21 +253,6 @@ start tf muid processTracker portman plugins rlog appname bundle removeFromList
     chan <- newChan
     return (App $ writeChan chan, rest chan)
   where
-    runApp port dir config = do
-        otherEnv <- pluginsGetEnv plugins appname (bconfigRaw config)
-        let env = ("PORT", show port)
-                : ("APPROOT", (if aconfigSsl config then "https://" else "http://") ++ aconfigHost config)
-                : otherEnv
-        log' <- getIOLogger
-        liftIO $ monitorProcess
-            (log' . decodeUtf8With lenientDecode)
-            processTracker
-            (encodeUtf8 . fst <$> muid)
-            (encodeUtf8 $ either id id $ F.toText $ aconfigExec config)
-            (encodeUtf8 $ either id id $ F.toText dir)
-            (map encodeUtf8 $ aconfigArgs config)
-            (map (encodeUtf8 *** encodeUtf8) env)
-            rlog
 
     rest chan = forkKIO $ do
         mres <- unpackBundle tf (snd <$> muid) bundle appname
@@ -225,33 +369,19 @@ start tf muid processTracker portman plugins rlog appname bundle removeFromList
                 Right () -> return ()
     -}
 
-testApp :: Port -> IO Bool
-testApp port = do
-    res <- timeout (90 * 1000 * 1000) testApp'
-    return $ fromMaybe False res
-  where
-    testApp' = do
-        threadDelay $ 2 * 1000 * 1000
-        eres <- try $ Network.connectTo "127.0.0.1" $ Network.PortNumber $ fromIntegral port
-        case eres of
-            Left (_ :: IOException) -> testApp'
-            Right handle -> do
-                hClose handle
-                return True
-
 reload :: App -> AppInput -> IO ()
-reload (App f) _fixme = f Reload
+reload = error "FIXME"
 
 terminate :: App -> IO ()
-terminate (App f) = f Terminate
+terminate = error "FIXME"
 
 -- | Get the modification time of the bundle file this app was launched from,
 -- if relevant.
 getTimestamp :: App -> STM (Maybe EpochTime)
 getTimestamp _ = return Nothing -- FIXME
 
-pluginsGetEnv :: Plugins -> Appname -> Object -> IO (Either SomeException [(Text, Text)])
-pluginsGetEnv ps app o = try $ fmap concat $ mapM (\p -> pluginGetEnv p app o) ps
+pluginsGetEnv :: Plugins -> Appname -> Object -> IO [(Text, Text)]
+pluginsGetEnv ps app o = fmap concat $ mapM (\p -> pluginGetEnv p app o) ps
 
     {- FIXME handle static stanzas
     let staticReverse r = do

Keter/AppManager.hs

@@ -5,9 +5,7 @@
 module Keter.AppManager
     ( -- * Types
       AppManager
-    , AppId (..)
     , Action (..)
-    , AppInput (..)
       -- * Actions
     , perform
     , reloadAppList
@@ -28,8 +26,7 @@ import           Data.Maybe                (mapMaybe)
 import           Data.Maybe                (catMaybes)
 import qualified Data.Set                  as Set
 import qualified Filesystem.Path.CurrentOS as F
-import           Keter.App                 (App, AppId (..), AppInput (..),
-                                            AppStartConfig)
+import           Keter.App                 (App, AppStartConfig)
 import qualified Keter.App                 as App
 import           Keter.Types
 import           Prelude                   hiding (FilePath, log)
@@ -205,7 +202,7 @@ launchWorker AppManager {..} appid tstate tmnext mcurrentApp0 action0 = void $ f
                     case mRunningApp of
                         Nothing -> writeTVar tstate ASTerminated
                         Just runningApp -> writeTVar tstate $ ASRunning runningApp
-                Just next -> do
+                Just _next -> do
                     tmtimestamp <- newTVar $
                         case action of
                             Reload (AIBundle _fp timestamp) -> Just timestamp

Keter/HostManager.hs

@@ -6,7 +6,6 @@ module Keter.HostManager
     ( -- * Types
       HostManager
     , Reservations
-    , Conflicts
       -- * Actions
     , reserveHosts
     , forgetReservations
@@ -17,7 +16,7 @@ module Keter.HostManager
     ) where
 
 import           Control.Applicative
-import           Control.Exception       (assert)
+import           Control.Exception       (assert, throwIO)
 import           Data.Either             (partitionEithers)
 import qualified Data.Map                as Map
 import qualified Data.Set                as Set
@@ -27,12 +26,11 @@ import           Data.IORef
 
 type HMState = Map.Map HostBS HostValue
 
-data HostValue = HVActive !Appname !ProxyAction
-               | HVReserved !Appname
+data HostValue = HVActive !AppId !ProxyAction
+               | HVReserved !AppId
 
 newtype HostManager = HostManager (IORef HMState)
 
-type Conflicts = Map.Map Host Appname
 type Reservations = Set.Set Host
 
 start :: IO HostManager
@@ -54,25 +52,25 @@ start = HostManager <$> newIORef Map.empty
 -- 4. Otherwise, the hosts which were reserved are returned as @Right@. This
 --    does /not/ include previously active hosts.
 reserveHosts :: HostManager
-             -> Appname
+             -> AppId
              -> Set.Set Host
-             -> IO (Either Conflicts Reservations)
-reserveHosts (HostManager mstate) app hosts = atomicModifyIORef mstate $ \entries0 ->
+             -> IO Reservations
+reserveHosts (HostManager mstate) aid hosts = either (throwIO . CannotReserveHosts aid) return =<< atomicModifyIORef mstate (\entries0 ->
     case partitionEithers $ map (checkHost entries0) $ Set.toList hosts of
         ([], toReserve) ->
             (Set.foldr reserve entries0 $ Set.unions toReserve, Right Set.empty)
-        (conflicts, _) -> (entries0, Left $ Map.fromList conflicts)
+        (conflicts, _) -> (entries0, Left $ Map.fromList conflicts))
   where
     checkHost entries0 host =
         case Map.lookup (encodeUtf8 host) entries0 of
             Nothing -> Right $ Set.singleton host
-            Just (HVReserved app') -> assert (app /= app')
-                                    $ Left (host, app')
-            Just (HVActive app' _)
-                | app == app' -> Right Set.empty
-                | otherwise   -> Left (host, app')
+            Just (HVReserved aid') -> assert (aid /= aid')
+                                    $ Left (host, aid')
+            Just (HVActive aid' _)
+                | aid == aid' -> Right Set.empty
+                | otherwise   -> Left (host, aid')
 
-    hvres = HVReserved app
+    hvres = HVReserved aid
     reserve host es =
         assert (Map.notMember hostBS es) $ Map.insert hostBS hvres es
       where
@@ -80,7 +78,7 @@ reserveHosts (HostManager mstate) app hosts = atomicModifyIORef mstate $ \entrie
 
 -- | Forget previously made reservations.
 forgetReservations :: HostManager
-                   -> Appname
+                   -> AppId
                    -> Reservations
                    -> IO ()
 forgetReservations (HostManager mstate) app hosts = atomicModifyIORef mstate $ \state0 ->
@@ -98,7 +96,7 @@ forgetReservations (HostManager mstate) app hosts = atomicModifyIORef mstate $ \
 
 -- | Activate a new app. Note that you /must/ first reserve the hostnames you'll be using.
 activateApp :: HostManager
-            -> Appname
+            -> AppId
             -> Map.Map Host ProxyAction
             -> IO ()
 activateApp (HostManager mstate) app actions = atomicModifyIORef mstate $ \state0 ->

Keter/Main.hs

@@ -33,8 +33,6 @@ import qualified Data.Text                 as T
 import           Data.Text.Encoding        (encodeUtf8)
 import qualified Data.Text.Read
 import           Data.Time                 (getCurrentTime)
-import           Data.Typeable             (Typeable)
-import           Data.Yaml                 (ParseException)
 import           Data.Yaml.FilePath
 import qualified Filesystem                as F
 import qualified Filesystem.Path.CurrentOS as F
@@ -120,14 +118,12 @@ withManagers input mkPlugins f = withLogger input $ \kc@KeterConfig {..} log ->
             , ascHostManager = hostman
             , ascPortPool = portpool
             , ascPlugins = plugins
+            , ascLog = log
+            , ascKeterConfig = kc
             }
     appMan <- AppMan.initialize log appStartConfig
     f kc hostman appMan
 
-data InvalidKeterConfigFile = InvalidKeterConfigFile !FilePath !ParseException
-    deriving (Show, Typeable)
-instance Exception InvalidKeterConfigFile
-
 launchInitial :: KeterConfig -> AppMan.AppManager -> IO ()
 launchInitial kc@KeterConfig {..} appMan = do
     createTree incoming
@@ -136,8 +132,8 @@ launchInitial kc@KeterConfig {..} appMan = do
 
     unless (V.null kconfigBuiltinStanzas) $ AppMan.perform
         appMan
-        AppMan.AIBuiltin
-        (AppMan.Reload $ AppMan.AIData $ BundleConfig kconfigBuiltinStanzas mempty)
+        AIBuiltin
+        (AppMan.Reload $ AIData $ BundleConfig kconfigBuiltinStanzas mempty)
   where
     incoming = getIncoming kc
 

Keter/Types.hs

@@ -16,5 +16,6 @@ import Keter.Types.V10 as X
     , RedirectAction (..)
     , SourcePath (..)
     , ListeningPort (..)
+    , AppInput (..)
     )
 import Network.HTTP.ReverseProxy.Rewrite as X (ReverseProxyConfig (..), RewriteRule (..))

Keter/Types/Common.hs

@@ -112,6 +112,8 @@ data KeterException = CannotParsePostgres FilePath
                     | ExitCodeFailure FilePath ExitCode
                     | NoPortsAvailable
                     | InvalidConfigFile Data.Yaml.ParseException
+                    | InvalidKeterConfigFile !FilePath !Data.Yaml.ParseException
+                    | CannotReserveHosts !AppId !(Map Host AppId)
     deriving (Show, Typeable)
 instance Exception KeterException
 
@@ -126,3 +128,6 @@ logEx = do
             ]
     loc <- fmap showLoc TH.qLocation
     [|(. ExceptionThrown (pack $(TH.lift loc)))|]
+
+data AppId = AIBuiltin | AINamed !Appname
+    deriving (Eq, Ord, Show)

Keter/Types/V10.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Keter.Types.V10 where
 
+import Prelude hiding (FilePath)
+import           System.Posix.Types      (EpochTime)
 import Data.Aeson (Object)
 import Keter.Types.Common
 import qualified Keter.Types.V04 as V04
@@ -23,7 +26,7 @@ import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Handler.WarpTLS as WarpTLS
 
 data BundleConfig = BundleConfig
-    { bconfigStanzas :: !(Vector Stanza)
+    { bconfigStanzas :: !(Vector (Stanza ()))
     , bconfigRaw     :: !Object -- ^ used for plugins
     }
 
@@ -66,7 +69,7 @@ data KeterConfig = KeterConfig
     , kconfigPortPool :: V04.PortSettings
     , kconfigListeners :: !(NonEmptyVector ListeningPort)
     , kconfigSetuid :: Maybe Text
-    , kconfigBuiltinStanzas :: !(V.Vector Stanza)
+    , kconfigBuiltinStanzas :: !(V.Vector (Stanza ()))
     , kconfigIpFromHeader :: Bool
     }
 
@@ -111,10 +114,11 @@ instance ParseYamlFile KeterConfig where
             <*> return V.empty
             <*> o .:? "ip-from-header" .!= False
 
-data Stanza = StanzaStaticFiles StaticFilesConfig
-            | StanzaRedirect RedirectConfig
-            | StanzaWebApp WebAppConfig
-            | StanzaReverseProxy ReverseProxyConfig
+data Stanza port
+    = StanzaStaticFiles StaticFilesConfig
+    | StanzaRedirect RedirectConfig
+    | StanzaWebApp (WebAppConfig port)
+    | StanzaReverseProxy ReverseProxyConfig
             -- FIXME background job, console app
 
 -- | An action to be performed for a requested hostname.
@@ -129,7 +133,7 @@ data ProxyAction = PAPort Port
                  | PARedirect RedirectConfig
                  | PAReverseProxy ReverseProxyConfig
 
-instance ParseYamlFile Stanza where
+instance ParseYamlFile (Stanza ()) where
     parseYamlFile basedir = withObject "Stanza" $ \o -> do
         typ <- o .: "type"
         case typ of
@@ -206,25 +210,27 @@ instance FromJSON RedirectDest where
 
 type IsSecure = Bool
 
-data WebAppConfig = WebAppConfig
+data WebAppConfig port = WebAppConfig
     { waconfigExec        :: !F.FilePath
     , waconfigArgs        :: !(Vector Text)
     , waconfigApprootHost :: !Text -- ^ primary host, used for approot
     , waconfigHosts       :: !(Set Text) -- ^ all hosts, not including the approot host
     , waconfigSsl         :: !Bool
+    , waconfigPort        :: !port
     }
 
-instance ToCurrent WebAppConfig where
-    type Previous WebAppConfig = V04.AppConfig
+instance ToCurrent (WebAppConfig ()) where
+    type Previous (WebAppConfig ()) = V04.AppConfig
     toCurrent (V04.AppConfig exec args host ssl hosts _raw) = WebAppConfig
         { waconfigExec = exec
         , waconfigArgs = V.fromList args
         , waconfigApprootHost = host
         , waconfigHosts = hosts
         , waconfigSsl = ssl
+        , waconfigPort = ()
         }
 
-instance ParseYamlFile WebAppConfig where
+instance ParseYamlFile (WebAppConfig ()) where
     parseYamlFile basedir = withObject "WebAppConfig" $ \o -> do
         (ahost, hosts) <-
             (do
@@ -241,3 +247,7 @@ instance ParseYamlFile WebAppConfig where
             <*> return ahost
             <*> return hosts
             <*> o .:? "ssl" .!= False
+            <*> return ()
+
+data AppInput = AIBundle !FilePath !EpochTime
+              | AIData !BundleConfig