keter 2.2.0 → 2.2.1

raw patch · 3 files changed

+50/−8 lines, 3 filesdep ~tar

Dependency ranges changed: tar

Files

• ChangeLog.md +8/−0
• keter.cabal +2/−2
• src/Keter/AppManager.hs +40/−6

@@ -1,5 +1,13 @@ # Changelog +## 2.2.1+- Fix unnecessary file reloading: https://github.com/snoyberg/keter/pull/320+- bump tar+- drop support 9.4, add 9.12+- change from haskell/action to haskell-action.+  it told me to:+   Warning: As of 2023-09-09, haskell/action/setup is no longer maintained, please switch to haskell-actions/setup (note: dash for slash).+ ## 2.2.0  - **Dependency bounds:** Raised lower bound of `http-reverse-proxy` to `>= 0.6.2.0`.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               keter-version:            2.2.0+version:            2.2.1 synopsis:   Web application deployment manager, focusing on Haskell web frameworks. It mitigates downtime. @@ -56,7 +56,7 @@     , random                >=1.2.1    && <1.4     , regex-tdfa            >=1.3.1    && <1.4     , stm                   >=2.5.0    && <2.6-    , tar                   >=0.6.0.0  && <0.7+    , tar                   >=0.6.0.0  && <0.8     , template-haskell      >=2.17.0   && <3.0     , text                  >=1.2.5    && <3.0     , time                  >=1.9.3    && <2.0

@@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DoAndIfThenElse #-} -- | Used for management of applications. module Keter.AppManager     ( -- * Types@@ -19,12 +20,12 @@     ) where  import Control.Applicative-import Control.Concurrent (forkIO)+import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar (MVar, newMVar, withMVar) import Control.Concurrent.STM import Control.Exception (SomeException) import Control.Exception qualified as E-import Control.Monad (forM_, void)+import Control.Monad (forM_, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Unlift (withRunInIO) import Control.Monad.Logger@@ -48,11 +49,13 @@ import System.FilePath (FilePath) import System.Posix.Files (getFileStatus, modificationTime) import System.Posix.Types (EpochTime)+import System.Directory (getFileSize, getModificationTime)  data AppManager = AppManager     { apps           :: !(TVar (Map AppId (TVar AppState)))     , appStartConfig :: !AppStartConfig     , mutex          :: !(MVar ())+    , loads          :: !(TVar [FilePath])     }  renderApps :: AppManager -> STM Text@@ -72,6 +75,7 @@       <$> newTVarIO Map.empty       <*> return asc       <*> newMVar ()+      <*> newTVarIO []  -- | Reset which apps are running. --@@ -237,7 +241,7 @@      reloadMsg :: String -> String -> Text     reloadMsg app input =-        pack $ "Reloading from: " <> app <> input+        pack $ "Reloading from: " <> app <> ", " <> input      errorStartingBundleMsg :: String -> String -> Text     errorStartingBundleMsg bundleName e =@@ -246,7 +250,7 @@     processAction :: Maybe App -> Action -> KeterM AppManager (Maybe App)     processAction Nothing Terminate = return Nothing     processAction (Just app) Terminate = do-        $logInfo $ pack ("Terminating" <> show app)+        $logInfo $ pack ("Terminating " <> show app)         withMappedConfig (const app) App.terminate         return Nothing     processAction Nothing (Reload input) = do@@ -278,8 +282,27 @@  addApp :: FilePath -> KeterM AppManager () addApp bundle = do-    (input, action) <- liftIO $ getInputForBundle bundle-    perform input action+    AppManager {..} <- ask+    withRunInIO $ \rio -> do+        waitAndPerform' <- liftIO $ atomically $ do+            loads' <- readTVar loads+            if bundle `elem` loads'+            then return skipLoading+            else do+                putBundleIntoQueue loads+                return waitAndPerform+        void $ forkIO $ rio waitAndPerform'+    where+    skipLoading = do+        return ()+    waitAndPerform = do+        waitUntilStable bundle+        AppManager {..} <- ask+        removeBundleFromQueue loads+        (input, action) <- liftIO $ getInputForBundle bundle+        perform input action+    putBundleIntoQueue loads = modifyTVar loads (bundle:)+    removeBundleFromQueue loads = liftIO $ atomically $ modifyTVar loads $ filter (/= bundle)  getInputForBundle :: FilePath -> IO (AppId, Action) getInputForBundle bundle = do@@ -288,3 +311,14 @@  terminateApp :: Appname -> KeterM AppManager () terminateApp appname = perform (AINamed appname) Terminate++waitUntilStable :: FilePath -> KeterM AppManager ()+waitUntilStable path = liftIO $ loop Nothing+    where+    loop old = do+        size <- getFileSize path+        time <- getModificationTime path+        let new = Just (size, time)+        when (new /= old) $ do+            threadDelay 1000000 -- wait 1 sec+            loop new