Added more arguments to control scripts (#62)

* format * Added more arguments to scripts * Updated docs
2024-11-22 08:45:20 +03:00 · 2021-08-08 17:02:33 +03:00 · 2021-08-08 17:02:33 +03:00 · ec792b25d2
commit ec792b25d2
parent 9e1dcb4996
6 changed files with 276 additions and 173 deletions
--- a/docs/en/Control_scripts.md
+++ b/docs/en/Control_scripts.md
@ -181,6 +181,8 @@ This script checks the status of the deployment.

 This script receives the following additional command-line arguments as input:
 * `--tag` – The _Docker Image tag_ that should be checked.
+* `--app-env-override` [⭐](#star) – App-level overrides. These overrides should be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.
+* `--deployment-override` [⭐](#star) – Deployment-level overrides. These overrides should be used to set up the deployment environment itself, rather than be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.

 If the script exits with `0`, it means that the deployment is healthy and up. If the script exits with a non-zero exit code, it means that the deployment is not healthy or down.

@ -194,7 +196,7 @@ You can specify exactly what error occured using exit codes:
 The script might be called something like this:

 ```bash
-check --project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button"
+check ---project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button" --tag "c9bbc3fcc69e5aa094bca110c6f79419ab7be77a" --app-env-override "EMAIL_TOKEN=123123" --app-env-override "SECRET_BUTTON_ENABLED=True" --deployment-override "FANCY_DATABASE=True"
 ```

 #### Sample implementation
@ -261,13 +263,15 @@ This script is called right before [`create`](#-create) and [`update`](#-update)

 This script receives the following additional command-line arguments as input:
 * `--tag` – The _Docker Image tag_ that should be checked.
+* `--app-env-override` [⭐](#star) – App-level overrides. These overrides should be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.
+* `--deployment-override` [⭐](#star) – Deployment-level overrides. These overrides should be used to set up the deployment environment itself, rather than be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.

 #### Execution example

 The script might be called something like this:

 ```bash
-tag_check --project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button" --tag "c9bbc3fcc69e5aa094bca110c6f79419ab7be77a"
+tag_check --project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button" --tag "c9bbc3fcc69e5aa094bca110c6f79419ab7be77a" --app-env-override "EMAIL_TOKEN=123123" --app-env-override "SECRET_BUTTON_ENABLED=True" --deployment-override "FANCY_DATABASE=True"
 ```

 ### 👀 info
@ -276,6 +280,11 @@ tag_check --project-name "Cactus store" --base-domain "cactus-store.com" --names

 This script returns user-facing metadata about a deployment. Currently, the metadata consists of URLs that are relevant for the deployment. Things like the deployment URL, the URL to view logs, and the database URL.

+This script receives the following additional command-line arguments as input:
+* `--tag` – The _Docker Image tag_ that should be checked.
+* `--app-env-override` [⭐](#star) – App-level overrides. These overrides should be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.
+* `--deployment-override` [⭐](#star) – Deployment-level overrides. These overrides should be used to set up the deployment environment itself, rather than be passed to the server being deployed. These overrides are specified in the _Web UI_. They are passed in the format of `KEY=VALUE` pairs.
+
 The script should return the metadata as a two-column CSV table:

 ```
@ -290,7 +299,7 @@ This script receives only [the default command-line arguments](#general-behavior
 The script might be called something like this:

 ```bash
-info --project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button"
+info --project-name "Cactus store" --base-domain "cactus-store.com" --namespace "cactus" --name "orange-button" --tag "c9bbc3fcc69e5aa094bca110c6f79419ab7be77a" --app-env-override "EMAIL_TOKEN=123123" --app-env-override "SECRET_BUTTON_ENABLED=True" --deployment-override "FANCY_DATABASE=True"
 ```

 #### Sample implementation
--- a/octopod-backend/octopod-backend.cabal
+++ b/octopod-backend/octopod-backend.cabal
@ -54,6 +54,7 @@ library
                     , TypeFamilies
                     , QuantifiedConstraints
                     , DeriveAnyClass
+                     , ViewPatterns
  exposed-modules:
      Octopod.Server
      Octopod.Server.Args
--- a/octopod-backend/src/Octopod/Server.hs
+++ b/octopod-backend/src/Octopod/Server.hs
@ -8,7 +8,7 @@ import Control.Concurrent.Async (race_)
 import qualified Control.Concurrent.Lifted as L
 import Control.Concurrent.MVar
 import Control.Concurrent.STM
-import Control.Exception (Exception, throwIO, try)
+import Control.Exception (Exception, displayException, throwIO, try)
 import qualified Control.Exception.Lifted as L
 import Control.Lens hiding (Context, pre)
 import Control.Lens.Extras
@ -34,6 +34,7 @@ import Data.Int (Int64)
 import Data.Maybe
 import Data.Pool
 import Data.Text (lines, pack, unpack, unwords)
+import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Data.Traversable
 import Database.PostgreSQL.Simple hiding ((:.))
@ -391,7 +392,7 @@ createH dep = do
  t1 <- liftIO $ now
  st <- ask
  let pgPool = pool st
-  failIfImageNotFound (name dep) (tag dep)
+  failIfImageNotFound dep
  failIfGracefulShutdownActivated
  runDeploymentBgWorker
    Nothing
@ -426,7 +427,7 @@ createH dep = do
      liftIO . withResource pgPool $ \conn ->
        upsertNewOverrides conn dId (appOverrides dep) (deploymentOverrides dep)
      liftBase $ sendReloadEvent st
-      liftBase $ updateDeploymentInfo (name dep) st
+      updateDeploymentInfo (name dep)
      (ec, out, err) <- liftBase $ createDeployment dep st
      t2 <- liftBase $ now
      let elTime = elapsedTime t2 t1
@ -438,17 +439,21 @@ createH dep = do
  pure Success

 -- | Updates deployment info.
-updateDeploymentInfo :: DeploymentName -> AppState -> IO ()
-updateDeploymentInfo dName st = do
-  let log = logWarning (logger st)
-      args = infoCommandArgs (projectName st) (baseDomain st) (namespace st) dName
-      cmd = coerce $ infoCommand st
-  liftIO $ do
-    (ec, out, err) <- runCommand (unpack cmd) (coerce args)
+updateDeploymentInfo ::
+  (MonadReader AppState m, MonadBaseControl IO m, MonadError ServerError m) =>
+  DeploymentName ->
+  m ()
+updateDeploymentInfo dName = do
+  log <- asks (logWarning . logger)
+  pgPool <- asks pool
+  DeploymentFullInfo {deployment = dep} <-
+    withResource pgPool $ \conn -> getDeploymentS conn dName
+  (ec, out, err) <- runCommandArgs infoCommand =<< infoCommandArgs dep
+  liftBase $
    case ec of
      ExitSuccess -> do
        dMeta <- parseDeploymentMetadata (lines . unStdout $ out)
-        upsertDeploymentMetadata (pool st) dName dMeta
+        upsertDeploymentMetadata pgPool dName dMeta
      ExitFailure _ ->
        log $
          "could not get deployment info, exit code: " <> (pack . show $ ec)
@ -484,23 +489,6 @@ createDeployment dep st = do
    log $ "deployment created, deployment: " <> (pack . show $ dep)
    pure (ec, out, err)

-- | Converts an application-level override list to command arguments.
-applicationOverrideToArg :: ApplicationOverride -> [Text]
-applicationOverrideToArg o = ["--app-env-override", overrideToArg . coerce $ o]
-
-- | Helper to convert an application-level override to command arguments.
-applicationOverridesToArgs :: ApplicationOverrides -> [Text]
-applicationOverridesToArgs ovs = concat [applicationOverrideToArg o | o <- ovs]
-
-- | Converts a deployment-level override list to command arguments.
-deploymentOverrideToArg :: DeploymentOverride -> [Text]
-deploymentOverrideToArg o =
-  ["--deployment-override", overrideToArg . coerce $ o]
-
-- | Helper to convert a deployment-level override to command arguments.
-deploymentOverridesToArgs :: DeploymentOverrides -> [Text]
-deploymentOverridesToArgs ovs = concat [deploymentOverrideToArg o | o <- ovs]
-
 -- | Helper to get deployment logs.
 selectDeploymentLogs ::
  PgPool ->
@ -527,15 +515,22 @@ selectDeployment ::
  AppM Deployment
 selectDeployment dName = do
  pgPool <- asks pool
+  liftBaseOp (withResource pgPool) $ \conn ->
+    liftIO (selectDeploymentIO conn dName) >>= either throwError pure
+
+selectDeploymentIO ::
+  Connection ->
+  DeploymentName ->
+  IO (Either ServerError Deployment)
+selectDeploymentIO conn dName = do
  let q = "SELECT name, tag FROM deployments WHERE name = ?"
-  liftBaseOp (withResource pgPool) $ \conn -> do
-    retrieved <- liftBase $ query conn q (Only dName)
-    case retrieved of
-      [(n, t)] -> do
-        (appOvs, stOvs) <- liftBase $ selectOverrides conn n
-        pure $ Deployment n t appOvs stOvs
-      [] -> throwError err404 {errBody = "Deployment not found."}
-      _ -> throwError err500
+  retrieved <- liftBase $ query conn q (Only dName)
+  case retrieved of
+    [(n, t)] -> do
+      (appOvs, stOvs) <- liftBase $ selectOverrides conn n
+      pure . Right $ Deployment n t appOvs stOvs
+    [] -> pure . Left $ err404 {errBody = "Deployment not found."}
+    _ -> pure . Left $ err500

 data StatusTransitionProcessOutput = StatusTransitionProcessOutput
  { exitCode :: ExitCode
@ -757,7 +752,8 @@ updateH dName dUpdate = do
      pgPool = pool st
      log = logInfo (logger st)
  dId <- selectDeploymentId pgPool dName
-  failIfImageNotFound dName dTag
+  olDep <- selectDeployment dName
+  failIfImageNotFound (applyDeploymentUpdate dUpdate olDep)
  failIfGracefulShutdownActivated
  runDeploymentBgWorker (Just UpdatePending) dName (pure ()) $ \() -> do
    (appOvs, depOvs) <- liftBase . withResource pgPool $ \conn ->
@ -766,7 +762,7 @@ updateH dName dUpdate = do
        upsertNewOverrides conn dId newAppOvs newDepOvs
        updateTag conn dId dTag
        selectOverrides conn dName
-    liftBase $ updateDeploymentInfo dName st
+    updateDeploymentInfo dName
    liftBase $ sendReloadEvent st
    let args =
          [ "--project-name"
@ -1000,7 +996,7 @@ statusH :: DeploymentName -> AppM CurrentDeploymentStatus
 statusH dName = do
  pgPool <- asks pool
  dep <- withResource pgPool $ \conn -> getDeploymentS conn dName
-  (ec, _, _) <- runCommandArgs checkingCommand =<< checkCommandArgs dName (dep ^. #deployment . #tag)
+  (ec, _, _) <- runCommandArgs checkingCommand =<< checkCommandArgs (dep ^. #deployment)
  pure . CurrentDeploymentStatus $
    case ec of
      ExitSuccess -> Ok
@ -1102,11 +1098,11 @@ restoreH dName = do
  t1 <- liftIO $ now
  st <- ask
  dep <- selectDeployment dName
-  failIfImageNotFound (name dep) (tag dep)
+  failIfImageNotFound dep
  failIfGracefulShutdownActivated
  runDeploymentBgWorker (Just CreatePending) dName (pure ()) $ \() -> do
    dep' <- selectDeployment dName
-    liftBase $ updateDeploymentInfo dName st
+    updateDeploymentInfo dName
    (ec, out, err) <- liftBase $ createDeployment dep' st
    t2 <- liftBase now
    let elTime = elapsedTime t2 t1
@ -1248,28 +1244,9 @@ upsertDeploymentMetadata pgPool dName dMetadatas = do

 -- | Checks the existence of a deployment tag.
 -- Returns 404 'Tag not found' response if the deployment tag doesn't exist.
-failIfImageNotFound :: DeploymentName -> DeploymentTag -> AppM ()
-failIfImageNotFound dName dTag = do
-  st <- ask
-  let log :: Text -> IO ()
-      log = logInfo (logger st)
-      args =
-        [ "--project-name"
-        , coerce $ projectName st
-        , "--base-domain"
-        , coerce $ baseDomain st
-        , "--namespace"
-        , coerce $ namespace st
-        , "--name"
-        , coerce $ dName
-        , "--tag"
-        , coerce $ dTag
-        ]
-      cmd = coerce $ tagCheckingCommand st
-
-  ec <- liftIO $ do
-    log $ "call " <> unwords (cmd : args)
-    runCommandWithoutPipes (unpack cmd) (unpack <$> args)
+failIfImageNotFound :: Deployment -> AppM ()
+failIfImageNotFound dep = do
+  (ec, _, _) <- runCommandArgs tagCheckingCommand =<< tagCheckCommandArgs dep
  case ec of
    ExitSuccess -> pure ()
    ExitFailure _ ->
@ -1316,11 +1293,19 @@ runStatusUpdater state = do
      withResource pgPool $ \conn -> query conn selectDeps (Only interval)
    let checkList :: [(DeploymentName, DeploymentStatus, Timestamp, DeploymentTag)] =
          (\(n, s, t, dTag) -> (n, s, coerce t, dTag)) <$> rows
-    checkResult <- for checkList $ \(dName, dStatus, ts, dTag) -> do
+    checkResult <- for checkList $ \(dName, dStatus, ts, _) -> do
      let timeout = statusUpdateTimeout state
      (ec, _, _) <- flip runReaderT state case dStatus of
        ArchivePending -> runCommandArgs archiveCheckingCommand =<< archiveCheckArgs dName
-        _ -> runCommandArgs checkingCommand =<< checkCommandArgs dName dTag
+        _ -> do
+          liftBase (withResource pgPool $ \conn -> selectDeploymentIO conn dName) >>= \case
+            Right dep -> runCommandArgs checkingCommand =<< checkCommandArgs dep
+            Left err -> do
+              log <- asks logger
+              let err' = T.pack $ displayException $ err
+              liftIO $ logWarning log err'
+              pure (ExitFailure 1, Stdout "Didn't call script", Stderr err')
+
      pure (dName, statusTransition ec dStatus ts timeout, dStatus)
    updated <-
      for checkResult $ \(dName, transitionM, dStatus) ->
--- a/octopod-backend/src/Octopod/Server/ControlScriptUtils.hs
+++ b/octopod-backend/src/Octopod/Server/ControlScriptUtils.hs
@ -1,138 +1,207 @@
-{-|
-Module      : Octopod.Server.ControlScriptUtils
-Description : Control script utils.
-
-This module contains control script utils.
-}
-
-
+-- |
+--Module      : Octopod.Server.ControlScriptUtils
+--Description : Control script utils.
+--
+--This module contains control script utils.
 module Octopod.Server.ControlScriptUtils
-  ( infoCommandArgs
-  , notificationCommandArgs
-  , runCommand
-  , runCommandWithoutPipes
-  , runCommandArgs
-  , runCommandArgs'
-  , checkCommandArgs
-  , archiveCheckArgs
-  ) where
+  ( infoCommandArgs,
+    notificationCommandArgs,
+    runCommand,
+    runCommandWithoutPipes,
+    runCommandArgs,
+    runCommandArgs',
+    checkCommandArgs,
+    archiveCheckArgs,
+    tagCheckCommandArgs,

+    -- * Helpers
+    applicationOverrideToArg,
+    applicationOverridesToArgs,
+    deploymentOverrideToArg,
+    deploymentOverridesToArgs,
+  )
+where

-import           Control.Monad.Base
-import           Control.Monad.Reader
+import Control.Monad.Base
+import Control.Monad.Reader
 import qualified Data.ByteString.Lazy as TL
-import           Data.Coerce
-import           Data.Generics.Product.Typed
+import Data.Coerce
+import Data.Generics.Product.Typed
+import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import           Octopod.Server.Logger
-import           System.Exit
-import           System.Log.FastLogger
-import           System.Process.Typed
-import           Types
-
+import Octopod.Server.Logger
+import System.Exit
+import System.Log.FastLogger
+import System.Process.Typed
+import Types

 -- | Creates command arguments for the 'info' deployment control script.
-infoCommandArgs
-  :: ProjectName
-  -> Domain
-  -> Namespace
-  -> DeploymentName
-  -> ControlScriptArgs
-infoCommandArgs pName domain ns dName =
-  ControlScriptArgs
-    [ "--project-name", T.unpack . coerce $ pName
-    , "--base-domain", T.unpack . coerce $ domain
-    , "--namespace", T.unpack . coerce $ ns
-    , "--name", T.unpack . coerce $ dName ]
+infoCommandArgs ::
+  ( MonadReader r m
+  , HasType Namespace r
+  , HasType ProjectName r
+  , HasType Domain r
+  ) =>
+  Deployment ->
+  m ControlScriptArgs
+infoCommandArgs dep = do
+  (Namespace namespace) <- asks getTyped
+  (ProjectName projectName) <- asks getTyped
+  (Domain domain) <- asks getTyped
+  return $
+    ControlScriptArgs
+      [ "--project-name"
+      , T.unpack . coerce $ projectName
+      , "--base-domain"
+      , T.unpack . coerce $ domain
+      , "--namespace"
+      , T.unpack . coerce $ namespace
+      , "--name"
+      , T.unpack . coerce $ name dep
+      , "--tag"
+      , T.unpack . coerce $ tag dep
+      ]
+      <> getApplicationOverrideArgs dep
+      <> getDeploymentOverrideArgs dep

-notificationCommandArgs
-  ::
-    ( MonadReader r m
-    , HasType Namespace r
-    , HasType ProjectName r
-    , HasType Domain r
-    )
-  => DeploymentName
-  -> DeploymentTag
-  -> DeploymentStatus
-  -- ^ Previous status
-  -> DeploymentStatus
-  -- ^ New status
-  -> m ControlScriptArgs
+notificationCommandArgs ::
+  ( MonadReader r m
+  , HasType Namespace r
+  , HasType ProjectName r
+  , HasType Domain r
+  ) =>
+  DeploymentName ->
+  DeploymentTag ->
+  -- | Previous status
+  DeploymentStatus ->
+  -- | New status
+  DeploymentStatus ->
+  m ControlScriptArgs
 notificationCommandArgs dName dTag old new = do
  (Namespace namespace) <- asks getTyped
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
-  return $ ControlScriptArgs
-    [ "--project-name", T.unpack projectName
-    , "--base-domain", T.unpack domain
-    , "--namespace", T.unpack namespace
-    , "--name", T.unpack . coerce $ dName
-    , "--tag", T.unpack . coerce $ dTag
-    , "--old-status", T.unpack $ deploymentStatusText old
-    , "--new-status", T.unpack $ deploymentStatusText new
-    ]
+  return $
+    ControlScriptArgs
+      [ "--project-name"
+      , T.unpack projectName
+      , "--base-domain"
+      , T.unpack domain
+      , "--namespace"
+      , T.unpack namespace
+      , "--name"
+      , T.unpack . coerce $ dName
+      , "--tag"
+      , T.unpack . coerce $ dTag
+      , "--old-status"
+      , T.unpack $ deploymentStatusText old
+      , "--new-status"
+      , T.unpack $ deploymentStatusText new
+      ]

-checkCommandArgs
-  ::
-    ( MonadReader r m
-    , HasType Namespace r
-    , HasType ProjectName r
-    , HasType Domain r
-    )
-  => DeploymentName
-  -> DeploymentTag
-  -> m ControlScriptArgs
-checkCommandArgs dName dTag = do
+checkCommandArgs ::
+  ( MonadReader r m
+  , HasType Namespace r
+  , HasType ProjectName r
+  , HasType Domain r
+  ) =>
+  Deployment ->
+  m ControlScriptArgs
+checkCommandArgs dep = do
+  (Namespace namespace) <- asks getTyped
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
-  (Namespace namespace) <- asks getTyped
-  return $ ControlScriptArgs
-    [ "--namespace", T.unpack namespace
-    , "--name", T.unpack . coerce $ dName
-    , "--tag", T.unpack . unDeploymentTag $ dTag
-    , "--project-name", T.unpack projectName
-    , "--base-domain", T.unpack domain
-    ]
+  return $
+    ControlScriptArgs
+      [ "--project-name"
+      , T.unpack . coerce $ projectName
+      , "--base-domain"
+      , T.unpack . coerce $ domain
+      , "--namespace"
+      , T.unpack . coerce $ namespace
+      , "--name"
+      , T.unpack . coerce $ name dep
+      , "--tag"
+      , T.unpack . coerce $ tag dep
+      ]
+      <> getApplicationOverrideArgs dep
+      <> getDeploymentOverrideArgs dep

-archiveCheckArgs
-  ::
-    ( MonadReader r m
-    , HasType Namespace r
-    , HasType ProjectName r
-    , HasType Domain r
-    )
-  => DeploymentName
-  -> m ControlScriptArgs
+tagCheckCommandArgs ::
+  ( MonadReader r m
+  , HasType Namespace r
+  , HasType ProjectName r
+  , HasType Domain r
+  ) =>
+  Deployment ->
+  m ControlScriptArgs
+tagCheckCommandArgs dep = do
+  (Namespace namespace) <- asks getTyped
+  (ProjectName projectName) <- asks getTyped
+  (Domain domain) <- asks getTyped
+  return $
+    ControlScriptArgs
+      [ "--project-name"
+      , T.unpack . coerce $ projectName
+      , "--base-domain"
+      , T.unpack . coerce $ domain
+      , "--namespace"
+      , T.unpack . coerce $ namespace
+      , "--name"
+      , T.unpack . coerce $ name dep
+      , "--tag"
+      , T.unpack . coerce $ tag dep
+      ]
+      <> getApplicationOverrideArgs dep
+      <> getDeploymentOverrideArgs dep
+
+archiveCheckArgs ::
+  ( MonadReader r m
+  , HasType Namespace r
+  , HasType ProjectName r
+  , HasType Domain r
+  ) =>
+  DeploymentName ->
+  m ControlScriptArgs
 archiveCheckArgs dName = do
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
  (Namespace namespace) <- asks getTyped
-  return $ ControlScriptArgs
-    [ "--project-name", T.unpack projectName
-    , "--base-domain", T.unpack domain
-    , "--namespace", T.unpack namespace
-    , "--name", T.unpack . coerce $ dName
-    ]
+  return $
+    ControlScriptArgs
+      [ "--project-name"
+      , T.unpack projectName
+      , "--base-domain"
+      , T.unpack domain
+      , "--namespace"
+      , T.unpack namespace
+      , "--name"
+      , T.unpack . coerce $ dName
+      ]

-runCommandArgs
-  :: (MonadReader r m, MonadBase IO m, HasType TimedFastLogger r)
-  => (r -> Command) -> ControlScriptArgs -> m (ExitCode, Stdout, Stderr)
+runCommandArgs ::
+  (MonadReader r m, MonadBase IO m, HasType TimedFastLogger r) =>
+  (r -> Command) ->
+  ControlScriptArgs ->
+  m (ExitCode, Stdout, Stderr)
 runCommandArgs f args = do
  cmd <- asks f
  runCommandArgs' cmd args

-runCommandArgs'
-  :: (MonadBase IO m, HasType TimedFastLogger r, MonadReader r m)
-  => Command -> ControlScriptArgs -> m (ExitCode, Stdout, Stderr)
+runCommandArgs' ::
+  (MonadBase IO m, HasType TimedFastLogger r, MonadReader r m) =>
+  Command ->
+  ControlScriptArgs ->
+  m (ExitCode, Stdout, Stderr)
 runCommandArgs' (Command cmd) (ControlScriptArgs args) = do
  logger <- asks (getTyped @TimedFastLogger)
  let logText = T.unwords (cmd : fmap T.pack args)
  liftBase $ logInfo logger $ "calling: " <> logText
  res@(ec, _, _) <- runCommand (T.unpack cmd) args
-  liftBase $ logInfo logger
-    $ "calling `" <> logText <> "` exited with: " <> show' ec
+  liftBase $
+    logInfo logger $
+      "calling `" <> logText <> "` exited with: " <> show' ec
  return res

 -- | Helper to run command with pipes.
@ -149,3 +218,28 @@ runCommand cmd args = do
 runCommandWithoutPipes :: FilePath -> [String] -> IO ExitCode
 runCommandWithoutPipes cmd args =
  withProcessWait (proc cmd args) waitExitCode
+
+-- | Converts an application-level override list to command arguments.
+applicationOverrideToArg :: ApplicationOverride -> [Text]
+applicationOverrideToArg o = ["--app-env-override", overrideToArg . coerce $ o]
+
+-- | Helper to convert an application-level override to command arguments.
+applicationOverridesToArgs :: ApplicationOverrides -> [Text]
+applicationOverridesToArgs ovs = concat [applicationOverrideToArg o | o <- ovs]
+
+getApplicationOverrideArgs :: Deployment -> ControlScriptArgs
+getApplicationOverrideArgs =
+  ControlScriptArgs . map T.unpack . applicationOverridesToArgs . appOverrides
+
+-- | Converts a deployment-level override list to command arguments.
+deploymentOverrideToArg :: DeploymentOverride -> [Text]
+deploymentOverrideToArg o =
+  ["--deployment-override", overrideToArg . coerce $ o]
+
+-- | Helper to convert a deployment-level override to command arguments.
+deploymentOverridesToArgs :: DeploymentOverrides -> [Text]
+deploymentOverridesToArgs ovs = concat [deploymentOverrideToArg o | o <- ovs]
+
+getDeploymentOverrideArgs :: Deployment -> ControlScriptArgs
+getDeploymentOverrideArgs =
+  ControlScriptArgs . map T.unpack . deploymentOverridesToArgs . deploymentOverrides
--- a/octopod-backend/src/Types.hs
+++ b/octopod-backend/src/Types.hs
@ -75,3 +75,4 @@ newtype Command = Command {unCommand :: Text}
 newtype ControlScriptArgs = ControlScriptArgs
  {unControlScriptArgs :: [String]}
  deriving stock (Show)
+  deriving newtype (Semigroup, Monoid)
--- a/octopod-common/src/Common/Types.hs
+++ b/octopod-common/src/Common/Types.hs
@ -10,7 +10,7 @@ module Common.Types where
 import Data.Bifunctor
 import Data.Coerce
 import Data.String
-import Data.Text as T
+import Data.Text as T hiding (filter)
 import Data.Traversable
 import Deriving.Aeson.Stock
 import Web.HttpApiData
@ -187,6 +187,19 @@ data DeploymentUpdate = DeploymentUpdate
  deriving stock (Generic, Show)
  deriving (FromJSON, ToJSON) via Snake DeploymentUpdate

+applyDeploymentUpdate :: DeploymentUpdate -> Deployment -> Deployment
+applyDeploymentUpdate du d =
+  Deployment
+    { name = name d
+    , tag = newTag du
+    , appOverrides =
+        filter (`notElem` oldAppOverrides du) (appOverrides d)
+          <> newAppOverrides du
+    , deploymentOverrides =
+        filter (`notElem` oldDeploymentOverrides du) (deploymentOverrides d)
+          <> newDeploymentOverrides du
+    }
+
 data CurrentStatus
  = Ok
  | Error