Refactored queries to not be strings (#68)

* Rel8ed backend * Removed rel8 dependency from common * Format frontend * Made frontend compile * Migrations * Fixed Actions encoding * Fixed timeout * Fixed overrides * Fixed deployment duration * Fixed inserting deployment logs * Removed postgresql-simple * Fixed octo CLI
2024-09-17 18:17:48 +03:00 · 2021-08-26 18:14:29 +03:00 · 2021-08-26 18:14:29 +03:00 · 0336964bab
commit 0336964bab
parent 90fa7b8108
27 changed files with 1555 additions and 1522 deletions
--- a/default.nix
+++ b/default.nix
@ -35,7 +35,7 @@ let
      }
    ];
-    index-state = "2021-07-02T00:00:00Z";
+    index-state = "2021-08-04T00:00:00Z";
    compiler-nix-name = "ghc8105";
  };
 in
--- a/migrations/deploy/migrate_2.0.sql
+++ b/migrations/deploy/migrate_2.0.sql
@ -0,0 +1,62 @@
 -- Deploy octopod:migrate_2.0 to pg
 BEGIN;
 -- XXX Add DDLs here.
 ALTER TABLE deployments ADD COLUMN app_overrides jsonb;
 UPDATE deployments AS d SET app_overrides =
  ( SELECT COALESCE(jsonb_agg(jsonb_build_array("do".key, jsonb_build_object('tag', 'ValueAdded', 'contents', "do".value))), jsonb_build_array())
    FROM deployment_overrides as "do"
    WHERE d.id = "do".deployment_id AND scope = 'ApplicationScope'
  );
 ALTER TABLE deployments ALTER COLUMN app_overrides SET NOT NULL;
 ALTER TABLE deployments ADD COLUMN deployment_overrides jsonb;
 UPDATE deployments AS d SET deployment_overrides =
  ( SELECT COALESCE(jsonb_agg(jsonb_build_array("do".key, jsonb_build_object('tag', 'ValueAdded', 'contents', "do".value))), jsonb_build_array())
    FROM deployment_overrides as "do"
    WHERE d.id = "do".deployment_id AND scope = 'DeploymentScope'
  );
 ALTER TABLE deployments ALTER COLUMN deployment_overrides SET NOT NULL;
 ALTER TABLE deployments ADD COLUMN links jsonb;
 UPDATE deployments AS d SET links =
  ( SELECT COALESCE(jsonb_agg(jsonb_build_object('name', "dm".key, 'link', "dm".value)), jsonb_build_array())
    FROM deployment_metadata as "dm"
    WHERE d.id = "dm".deployment_id
  );
 ALTER TABLE deployments ALTER COLUMN links SET NOT NULL;
 ALTER TABLE deployments ALTER COLUMN "status" DROP DEFAULT;
 ALTER TABLE deployments ALTER COLUMN "status" TYPE text;
 DROP TABLE deployment_overrides;
 DROP TABLE deployment_metadata;
 ALTER TABLE deployment_logs ALTER COLUMN "action" TYPE text;
 ALTER TABLE deployment_logs ALTER COLUMN "duration" DROP DEFAULT;
 ALTER TABLE deployment_logs ALTER COLUMN "duration" TYPE interval USING (duration || ' seconds') :: interval;
 ALTER TABLE deployment_logs ADD COLUMN deployment_overrides jsonb;
 UPDATE deployment_logs AS d SET deployment_overrides =
  ( SELECT COALESCE(jsonb_agg(jsonb_build_array("do".key, jsonb_build_object('tag', 'ValueAdded', 'contents', "do".value))), jsonb_build_array())
    FROM deployment_log_overrides as "do"
    WHERE d.id = "do".deployment_log_id AND scope = 'DeploymentScope'
  );
 ALTER TABLE deployment_logs ALTER COLUMN deployment_overrides SET NOT NULL;
 ALTER TABLE deployment_logs ADD COLUMN app_overrides jsonb;
 UPDATE deployment_logs AS d SET app_overrides =
  ( SELECT COALESCE(jsonb_agg(jsonb_build_array("do".key, jsonb_build_object('tag', 'ValueAdded', 'contents', "do".value))), jsonb_build_array())
    FROM deployment_log_overrides as "do"
    WHERE d.id = "do".deployment_log_id AND scope = 'ApplicationScope'
  );
 ALTER TABLE deployment_logs ALTER COLUMN app_overrides SET NOT NULL;
 DROP TABLE deployment_log_overrides;
 COMMIT;
--- a/migrations/revert/migrate_2.0.sql
+++ b/migrations/revert/migrate_2.0.sql
@ -0,0 +1,12 @@
 -- Revert octopod:migrate_2.0 from pg
 BEGIN;
 DO LANGUAGE 'plpgsql'
 $$
 BEGIN
 RAISE EXCEPTION 'Revert not supported for this migration';
 END
 $$;
 COMMIT;
--- a/migrations/sqitch.plan
+++ b/migrations/sqitch.plan
@ -15,3 +15,4 @@ rename-delete-to-archive 2020-11-23T10:53:10Z Ilya <octopod@typeable.io> # Renam
 rename_delete_to_archive_2 2020-11-26T08:28:58Z Typeable LLC <octopod@typeable.io> # Renamed delete to archive
 add_detailed_failures 2021-02-04T11:01:15Z Typeable LLC <octopod@typeable.io> # Added more failure states
 remove_archived_column 2021-01-28T18:44:54Z Typeable LLC <octopod@typeable.io> # Removed 'archived' column
 migrate_2.0 2021-08-11T17:09:37Z Typeable LLC <octopod@typeable.io> # Migrate to 2.0-style tables. (Less tables)
--- a/migrations/verify/migrate_2.0.sql
+++ b/migrations/verify/migrate_2.0.sql
@ -0,0 +1,37 @@
 -- Verify octopod:migrate_2.0 on pg
 BEGIN;
 SELECT
  id,
  name,
  tag,
  app_overrides,
  deployment_overrides,
  created_at,
  updated_at,
  archived_at,
  status,
  status_updated_at,
  checked_at,
  links
 FROM deployments
 WHERE false;
 SELECT
  id,
  deployment_id,
  action,
  tag,
  exit_code,
  created_at,
  archived,
  duration,
  stdout,
  stderr,
  app_overrides,
  deployment_overrides
 FROM deployment_logs
 WHERE false;
 ROLLBACK;
--- a/octo-cli/octo-cli.cabal
+++ b/octo-cli/octo-cli.cabal
@ -44,7 +44,7 @@ executable octo
    aeson,
    base,
    bytestring,
-    chronos,
+    time,
    data-default-class,
    generic-lens,
    http-client-tls,
@ -59,6 +59,7 @@ executable octo
    transformers,
    table-layout ^>= 0.9.0.0,
    servant-auth,
    ordered-containers,
  hs-source-dirs: src
  default-language: Haskell2010
  ghc-options:
--- a/octo-cli/src/Octopod/CLI.hs
+++ b/octo-cli/src/Octopod/CLI.hs
@ -2,9 +2,9 @@
 module Octopod.CLI (runOcto) where
 import Chronos
 import Common.Types
 import Common.Utils (dfiName)
 import Control.Exception
 import Control.Lens hiding (List)
 import Control.Monad
 import Control.Monad.IO.Class
@ -14,11 +14,14 @@ import qualified Data.ByteString.Lazy.Char8 as LBSC
 import Data.Coerce
 import Data.Generics.Labels ()
 import Data.Generics.Product
 import qualified Data.Map.Ordered.Strict as OM
 import Data.Maybe
 import Data.Proxy
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Text.Lens
 import Data.Time
 import GHC.IO.Encoding
 import Network.HTTP.Client.TLS
 import Octopod.CLI.Args
@ -45,6 +48,9 @@ import Text.Layout.Table
 import Text.Layout.Table.Extras ()
 import Prelude as P
 dieT :: MonadIO m => Text -> m a
 dieT = liftIO . die . T.unpack
 -- | Runs the octo CLI.
 runOcto :: IO ()
 runOcto = do
@ -58,27 +64,17 @@ runOcto = do
  let clientEnv = mkClientEnv manager env
  flip runReaderT clientEnv $
    case args of
-      Create tName tTag tSetAp tSetDep tSetPAp tSetPDep -> do
+      Create tName tTag tSetAp tSetDep -> do
-        setApp <- liftIO $ parseSetApplicationOverrides Public tSetAp
+        appOvs <- either dieT pure $ parseSetOverrides tSetAp
-        setDep <- liftIO $ parseSetDeploymentOverrides Public tSetDep
+        depOvs <- either dieT pure $ parseSetOverrides tSetDep
        setPApp <- liftIO $ parseSetApplicationOverrides Private tSetPAp
        setPDep <- liftIO $ parseSetDeploymentOverrides Private tSetPDep
        let appOvs = setApp ++ setPApp
            depOvs = setDep ++ setPDep
        handleCreate auth $ Deployment (coerce tName) (coerce tTag) appOvs depOvs
      List -> handleList auth
      Archive tName -> handleArchive auth . coerce $ tName
-      Update tName tTag tSetAp tUnsAp tSetD tUnsD tSetPAp tSetPD -> do
+      Update tName tTag tSetAp unsetApp tSetD unsetDep -> do
-        setApp <- liftIO $ parseSetApplicationOverrides Public tSetAp
+        appOvs <- either dieT pure $ parseSetOverrides tSetAp
-        setDep <- liftIO $ parseSetDeploymentOverrides Public tSetD
+        depOvs <- either dieT pure $ parseSetOverrides tSetD
-        unsetApp <- liftIO $ parseUnsetApplicationOverrides Public tUnsAp
+        let tName' = coerce tName
-        unsetDep <- liftIO $ parseUnsetDeploymentOverrides Public tUnsD
+            tTag' = coerce <$> tTag
        setPApp <- liftIO $ parseSetApplicationOverrides Private tSetPAp
        setPDep <- liftIO $ parseSetDeploymentOverrides Private tSetPD
        let appOvs = setApp ++ setPApp
            depOvs = setDep ++ setPDep
            tName' = coerce tName
            tTag' = coerce tTag
        handleUpdate auth tName' tTag' appOvs unsetApp depOvs unsetDep
      Info tName ->
        handleInfo auth . coerce $ tName
@ -130,26 +126,46 @@ handleArchive auth dName = do
 handleUpdate ::
  AuthContext AuthHeaderAuth ->
  DeploymentName ->
-  DeploymentTag ->
+  Maybe DeploymentTag ->
-  ApplicationOverrides ->
+  Overrides 'ApplicationLevel ->
-  ApplicationOverrides ->
+  [Text] ->
-  DeploymentOverrides ->
+  Overrides 'DeploymentLevel ->
-  DeploymentOverrides ->
+  [Text] ->
  ReaderT ClientEnv IO ()
-handleUpdate auth dName dTag dNewAppOvs dOldAppOvs dNewDepOvs dOldDepOvs = do
+handleUpdate auth dName dTag dNewAppOvs removedAppOvs dNewDepOvs removedDepOvs = do
  clientEnv <- ask
  dep <- runClientM' (_fullInfoH auth dName) clientEnv
  let removeAll :: Ord k => [k] -> OM.OMap k v -> Either k (OM.OMap k v)
      removeAll [] m = Right m
      removeAll (k : kk) m =
        if k `OM.member` m
          then removeAll kk $ OM.delete k m
          else Left k
      removeAllM :: MonadIO m => [Text] -> Overrides l -> m (Overrides l)
      removeAllM ks (Overrides m) =
        either
          (\k -> dieT $ "Override " <> k <> " not present in deployment.")
          (pure . Overrides)
          $ removeAll ks m
  appOverrides' <-
    fmap (<> dNewAppOvs) $
      removeAllM removedAppOvs $ dep ^. #deployment . #appOverrides
  deploymentOverrides' <-
    fmap (<> dNewDepOvs) $
      removeAllM removedDepOvs $ dep ^. #deployment . #deploymentOverrides
  liftIO $ do
    let dUpdate =
          DeploymentUpdate
-            { newTag = dTag
+            { newTag = fromMaybe (dep ^. #deployment . #tag) dTag
-            , newAppOverrides = dNewAppOvs
+            , appOverrides = appOverrides'
-            , oldAppOverrides = dOldAppOvs
+            , deploymentOverrides = deploymentOverrides'
            , newDeploymentOverrides = dNewDepOvs
            , oldDeploymentOverrides = dOldDepOvs
            }
    response <- runClientM (updateH auth dName dUpdate) clientEnv
    handleResponse (const $ pure ()) response
 runClientM' :: MonadIO m => ClientM a -> ClientEnv -> m a
 runClientM' req env = liftIO $ runClientM req env >>= either (die . displayException) pure
 -- | Handles the 'info' subcommand.
 handleInfo :: AuthContext AuthHeaderAuth -> DeploymentName -> ReaderT ClientEnv IO ()
 handleInfo auth dName = do
@ -192,13 +208,13 @@ handleGetActionInfo auth aId l = do
    runClientM (getActionInfoH auth aId) clientEnv >>= \case
      Left err -> print err
      Right x -> case l of
-        Out -> T.putStrLn $ x ^. #stdout
+        Out -> T.putStrLn . unStdout $ x ^. #stdout
-        Err -> T.putStrLn $ x ^. #stderr
+        Err -> T.putStrLn . unStderr $ x ^. #stderr
        ErrOut -> do
          T.putStrLn "\t\tstdout:\n"
-          T.putStrLn $ x ^. #stdout
+          T.putStrLn . unStdout $ x ^. #stdout
          T.putStrLn "\t\tstderr:\n"
-          T.putStrLn $ x ^. #stderr
+          T.putStrLn . unStderr $ x ^. #stderr
 listH :: AuthContext AuthHeaderAuth -> ClientM [DeploymentFullInfo]
 createH :: AuthContext AuthHeaderAuth -> Deployment -> ClientM CommandResponse
@ -260,19 +276,19 @@ decodeError body =
 -- | Pretty-prints the 'info' subcommand result.
 printInfo :: DeploymentInfo -> IO ()
-printInfo (DeploymentInfo (Deployment _ dTag dAppOvs dStOvs) dMeta dLogs) = do
+printInfo (DeploymentInfo (Deployment _ dTag dAppOvs dStOvs) (DeploymentMetadata dMeta) dLogs) = do
  T.putStrLn "Current settings:"
  T.putStrLn $ "tag: " <> coerce dTag
  T.putStrLn $
    "application overrides: "
-      <> (formatOverrides $ coerce <$> dAppOvs)
+      <> formatOverrides dAppOvs
  T.putStrLn $
    "deployment overrides: "
-      <> (formatOverrides $ coerce <$> dStOvs)
+      <> formatOverrides dStOvs
  T.putStrLn $ "metadata: "
  forM_ dMeta $ \m ->
    T.putStrLn $
-      "  " <> deploymentMetadataKey m <> ": " <> deploymentMetadataValue m
+      "  " <> m ^. #name <> ": " <> m ^. #link
  T.putStrLn ""
  T.putStrLn "Last logs:"
  ppDeploymentLogs dLogs
@ -308,21 +324,13 @@ ppDeploymentLogRow dLog =
  colsAllG
    top
    [
-      [ encode_YmdHMS
+      [ T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) $
-          SubsecondPrecisionAuto
+          dLog ^. field @"createdAt"
          w3c
          ( timeToDatetime . Time . fromIntegral $
              dLog ^. field @"createdAt" * 10 ^ (9 :: Int)
          )
      ]
    , [dLog ^. field @"actionId" . to unActionId . re _Show . packed]
-    , [dLog ^. field @"action" . coerced]
+    , [dLog ^. field @"action" . to actionToText]
    , [dLog ^. field @"deploymentTag" . coerced]
-    , dLog
+    , dLog ^. field @"deploymentAppOverrides" . to formatOverrides'
-        ^. field @"deploymentAppOverrides"
+    , dLog ^. field @"deploymentDepOverrides" . to formatOverrides'
          . to (fmap $ formatOverride . coerce)
    , dLog
        ^. field @"deploymentDepOverrides"
          . to (fmap $ formatOverride . coerce)
    , [dLog ^. field @"exitCode" . re _Show . packed]
    ]
--- a/octo-cli/src/Octopod/CLI/Args.hs
+++ b/octo-cli/src/Octopod/CLI/Args.hs
@ -20,10 +20,6 @@ data Args
        setAppOverrides :: [Text]
      , -- | deployment-level overrides to set
        setDeploymentOverrides :: [Text]
      , -- | application-level private overrides to set
        setAppPrivateOverrides :: [Text]
      , -- | deployment-level private overrides to set
        setDeploymentPrivateOverrides :: [Text]
      }
  | List
  | Archive
@ -34,7 +30,7 @@ data Args
      { -- | deployment name
        name :: Text
      , -- | deployment tag
-        tag :: Text
+        newTag :: Maybe Text
      , -- | application-level overrides to set
        setAppOverrides :: [Text]
      , -- | application-level overrides to unset
@ -43,10 +39,6 @@ data Args
        setDeploymentOverrides :: [Text]
      , -- | deployment-level overrides to unset
        unsetDeploymentOverrides :: [Text]
      , -- | application-level private overrides to set
        setAppPrivateOverrides :: [Text]
      , -- | deployment-level private overrides to set
        setDeploymentPrivateOverrides :: [Text]
      }
  | Info
      { -- | deployment name
@ -119,22 +111,6 @@ createArgs =
              <> help "set deployment level override"
          )
      )
    <*> many
      ( strOption
          ( long "set-app-env-private-override"
              <> short 'a'
              <> help "set application level private override"
              <> internal
          )
      )
    <*> many
      ( strOption
          ( long "set-deployment-private-override"
              <> short 's'
              <> help "set deployment level private override"
              <> internal
          )
      )
 -- | Parses arguments of 'list' subcommand.
 listArgs :: Parser Args
@ -152,7 +128,7 @@ updateArgs :: Parser Args
 updateArgs =
  Update
    <$> strOption (long "name" <> short 'n' <> help "deployment name")
-    <*> strOption (long "tag" <> short 't' <> help "deployment tag")
+    <*> optional (strOption (long "tag" <> short 't' <> help "deployment tag"))
    <*> many
      ( strOption
          ( long "set-app-env-override"
@ -181,22 +157,6 @@ updateArgs =
              <> help "unset a deployment level override"
          )
      )
    <*> many
      ( strOption
          ( long "set-app-env-private-override"
              <> short 'a'
              <> help "set application level private override"
              <> internal
          )
      )
    <*> many
      ( strOption
          ( long "set-deployment-private-override"
              <> short 's'
              <> help "set deployment level private override"
              <> internal
          )
      )
 -- | Parses arguments of 'info' subcommand.
 infoArgs :: Parser Args
--- a/octopod-backend/octopod-backend.cabal
+++ b/octopod-backend/octopod-backend.cabal
@ -63,9 +63,9 @@ library
      Octopod.Server.Posix
      Orphans
      Types
      Database.PostgreSQL.Simple.Instances
      Control.Octopod.DeploymentLock
      Octopod.PowerAPI.Auth.Server
      Octopod.Schema
  hs-source-dirs:
      src
  build-depends:
@ -73,7 +73,6 @@ library
    , async
    , base >=4.7 && <5
    , bytestring
    , chronos
    , conduit
    , deriving-aeson
    , octopod-common
@ -87,7 +86,6 @@ library
    , optparse-applicative
    , optparse-generic
    , postgresql-error-codes
    , postgresql-simple
    , resource-pool
    , servant
    , servant-server
@ -107,6 +105,11 @@ library
    , servant-auth-server
    , wai
    , jose
    , rel8
    , time
    , hasql
    , hasql-transaction
    , ordered-containers
  default-language: Haskell2010
 executable octopod-exe
--- a/octopod-backend/src/Database/PostgreSQL/Simple/Instances.hs
+++ b/octopod-backend/src/Database/PostgreSQL/Simple/Instances.hs
@ -1,33 +0,0 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Database.PostgreSQL.Simple.Instances
  (
  ) where
 import           Common.Types
 import           Control.Applicative
 import           Control.Arrow
 import qualified Data.Map as M
 import           Data.Text (Text)
 import           Database.PostgreSQL.Simple.FromField
 import           Database.PostgreSQL.Simple.ToField
 import qualified Data.Text.Encoding as T
 instance ToField DeploymentStatus where
  toField = toField @Text . deploymentStatusText
 instance FromField DeploymentStatus where
  fromField _ (Just b) =
    (either (const empty) pure . T.decodeUtf8' $ b) >>= maybe empty return . flip M.lookup m
    where
      m = M.fromList . fmap (deploymentStatusText &&& id) $
        [ Running
        , Failure GenericFailure
        , Failure TagMismatch
        , Failure PartialAvailability
        , CreatePending
        , UpdatePending
        , ArchivePending
        , Archived
        ]
  fromField _ Nothing = empty
--- a/octopod-backend/src/Octopod/Schema.hs
+++ b/octopod-backend/src/Octopod/Schema.hs
@ -0,0 +1,101 @@
 module Octopod.Schema
  ( DeploymentSchema (..),
    deploymentSchema,
    extractDeployment,
    DeploymentLogSchema (..),
    deploymentLogSchema,
    extractDeploymentLog,
  )
 where
 import Data.Generics.Product
 import Data.Int
 import Data.Time
 import GHC.Generics (Generic)
 import Orphans ()
 import Rel8
 import Types
 deploymentSchema :: TableSchema (DeploymentSchema Name)
 deploymentSchema =
  TableSchema
    { name = "deployments"
    , schema = Nothing
    , columns =
        DeploymentSchema
          { id_ = "id"
          , name = "name"
          , tag = "tag"
          , appOverrides = "app_overrides"
          , deploymentOverrides = "deployment_overrides"
          , createdAt = "created_at"
          , updatedAt = "updated_at"
          , archivedAt = "archived_at"
          , status = "status"
          , statusUpdatedAt = "status_updated_at"
          , checkedAt = "checked_at"
          , metadata = "links"
          }
    }
 data DeploymentSchema f = DeploymentSchema
  { id_ :: Column f DeploymentId
  , name :: Column f DeploymentName
  , tag :: Column f DeploymentTag
  , appOverrides :: Column f (Overrides 'ApplicationLevel)
  , deploymentOverrides :: Column f (Overrides 'DeploymentLevel)
  , createdAt :: Column f UTCTime
  , updatedAt :: Column f UTCTime
  , archivedAt :: Column f (Maybe UTCTime)
  , status :: Column f DeploymentStatus
  , statusUpdatedAt :: Column f UTCTime
  , checkedAt :: Column f UTCTime
  , metadata :: Column f DeploymentMetadata
  }
  deriving stock (Generic)
  deriving anyclass (Rel8able)
 extractDeployment :: DeploymentSchema Result -> Deployment
 extractDeployment = upcast
 data DeploymentLogSchema f = DeploymentLogSchema
  { actionId :: Column f ActionId
  , deploymentId :: Column f DeploymentId
  , action :: Column f Action
  , deploymentTag :: Column f DeploymentTag
  , exitCode :: Column f Int64
  , createdAt :: Column f UTCTime
  , archived :: Column f Bool
  , duration :: Column f Duration
  , stdout :: Column f Stdout
  , stderr :: Column f Stderr
  , deploymentAppOverrides :: Column f (Overrides 'ApplicationLevel)
  , deploymentDepOverrides :: Column f (Overrides 'DeploymentLevel)
  }
  deriving stock (Generic)
  deriving anyclass (Rel8able)
 deploymentLogSchema :: TableSchema (DeploymentLogSchema Name)
 deploymentLogSchema =
  TableSchema
    { name = "deployment_logs"
    , schema = Nothing
    , columns =
        DeploymentLogSchema
          { actionId = "id"
          , deploymentId = "deployment_id"
          , action = "action"
          , deploymentTag = "tag"
          , exitCode = "exit_code"
          , createdAt = "created_at"
          , archived = "archived"
          , duration = "duration"
          , stdout = "stdout"
          , stderr = "stderr"
          , deploymentAppOverrides = "app_overrides"
          , deploymentDepOverrides = "deployment_overrides"
          }
    }
 extractDeploymentLog :: DeploymentLogSchema Result -> DeploymentLog
 extractDeploymentLog = upcast
--- a/octopod-backend/src/Octopod/Server.hs
+++ b/octopod-backend/src/Octopod/Server.hs
--- a/octopod-backend/src/Octopod/Server/ControlScriptUtils.hs
+++ b/octopod-backend/src/Octopod/Server/ControlScriptUtils.hs
@ -15,19 +15,18 @@ module Octopod.Server.ControlScriptUtils
    tagCheckCommandArgs,
    -- * Helpers
-    applicationOverrideToArg,
+    fullConfigArgs,
-    applicationOverridesToArgs,
+    overridesArgs,
    deploymentOverrideToArg,
    deploymentOverridesToArgs,
  )
 where
 import Control.Lens
 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.Text (Text)
+import qualified Data.Map.Ordered.Strict as MO
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Octopod.Server.Logger
@ -43,9 +42,10 @@ infoCommandArgs ::
  , HasType ProjectName r
  , HasType Domain r
  ) =>
  FullDefaultConfig ->
  Deployment ->
  m ControlScriptArgs
-infoCommandArgs dep = do
+infoCommandArgs dCfg dep = do
  (Namespace namespace) <- asks getTyped
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
@ -58,12 +58,11 @@ infoCommandArgs dep = do
      , "--namespace"
      , T.unpack . coerce $ namespace
      , "--name"
-      , T.unpack . coerce $ name dep
+      , T.unpack . coerce $ dep ^. #name
      , "--tag"
      , T.unpack . coerce $ tag dep
      ]
-      <> getApplicationOverrideArgs dep
+      <> fullConfigArgs dCfg dep
      <> getDeploymentOverrideArgs dep
 notificationCommandArgs ::
  ( MonadReader r m
@ -95,9 +94,9 @@ notificationCommandArgs dName dTag old new = do
      , "--tag"
      , T.unpack . coerce $ dTag
      , "--old-status"
-      , T.unpack $ deploymentStatusText old
+      , T.unpack $ deploymentStatusToText old
      , "--new-status"
-      , T.unpack $ deploymentStatusText new
+      , T.unpack $ deploymentStatusToText new
      ]
 checkCommandArgs ::
@ -106,9 +105,10 @@ checkCommandArgs ::
  , HasType ProjectName r
  , HasType Domain r
  ) =>
  FullDefaultConfig ->
  Deployment ->
  m ControlScriptArgs
-checkCommandArgs dep = do
+checkCommandArgs dCfg dep = do
  (Namespace namespace) <- asks getTyped
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
@ -121,12 +121,11 @@ checkCommandArgs dep = do
      , "--namespace"
      , T.unpack . coerce $ namespace
      , "--name"
-      , T.unpack . coerce $ name dep
+      , T.unpack . coerce $ dep ^. #name
      , "--tag"
      , T.unpack . coerce $ tag dep
      ]
-      <> getApplicationOverrideArgs dep
+      <> fullConfigArgs dCfg dep
      <> getDeploymentOverrideArgs dep
 tagCheckCommandArgs ::
  ( MonadReader r m
@ -134,9 +133,10 @@ tagCheckCommandArgs ::
  , HasType ProjectName r
  , HasType Domain r
  ) =>
  FullDefaultConfig ->
  Deployment ->
  m ControlScriptArgs
-tagCheckCommandArgs dep = do
+tagCheckCommandArgs dCfg dep = do
  (Namespace namespace) <- asks getTyped
  (ProjectName projectName) <- asks getTyped
  (Domain domain) <- asks getTyped
@ -149,12 +149,11 @@ tagCheckCommandArgs dep = do
      , "--namespace"
      , T.unpack . coerce $ namespace
      , "--name"
-      , T.unpack . coerce $ name dep
+      , T.unpack . coerce $ dep ^. #name
      , "--tag"
      , T.unpack . coerce $ tag dep
      ]
-      <> getApplicationOverrideArgs dep
+      <> fullConfigArgs dCfg dep
      <> getDeploymentOverrideArgs dep
 archiveCheckArgs ::
  ( MonadReader r m
@ -219,27 +218,18 @@ runCommandWithoutPipes :: FilePath -> [String] -> IO ExitCode
 runCommandWithoutPipes cmd args =
  withProcessWait (proc cmd args) waitExitCode
-- | Converts an application-level override list to command arguments.
+fullConfigArgs :: FullDefaultConfig -> Deployment -> ControlScriptArgs
-applicationOverrideToArg :: ApplicationOverride -> [Text]
+fullConfigArgs defCfg dep =
-applicationOverrideToArg o = ["--app-env-override", overrideToArg . coerce $ o]
+  overridesArgs (applyOverrides (dep ^. #appOverrides) (appDefaultConfig defCfg))
    <> overridesArgs (applyOverrides (dep ^. #deploymentOverrides) (depDefaultConfig defCfg))
-- | Helper to convert an application-level override to command arguments.
+overridesArgs :: forall l. KnownOverrideLevel l => Config l -> ControlScriptArgs
-applicationOverridesToArgs :: ApplicationOverrides -> [Text]
+overridesArgs (Config cc) =
-applicationOverridesToArgs ovs = concat [applicationOverrideToArg o | o <- ovs]
+  ControlScriptArgs
-
+    . concatMap (\(T.unpack -> k, T.unpack -> v) -> [argumentName, k <> "=" <> v])
-getApplicationOverrideArgs :: Deployment -> ControlScriptArgs
+    . MO.assocs
-getApplicationOverrideArgs =
+    $ cc
-  ControlScriptArgs . map T.unpack . applicationOverridesToArgs . appOverrides
+  where
-
+    argumentName = case knownOverrideLevel @l of
-- | Converts a deployment-level override list to command arguments.
+      ApplicationLevel -> "--app-env-override"
-deploymentOverrideToArg :: DeploymentOverride -> [Text]
+      DeploymentLevel -> "--deployment-override"
 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/Orphans.hs
+++ b/octopod-backend/src/Orphans.hs
@ -3,17 +3,48 @@
 module Orphans () where
 import Common.Types
-import Database.PostgreSQL.Simple.FromField (FromField)
+import Data.Maybe
-import Database.PostgreSQL.Simple.ToField (ToField)
+import Rel8
-deriving newtype instance FromField Action
+parseTypeInformationFromMapping :: (Eq a, Eq b, DBType b, Show b, Show a) => [(a, b)] -> TypeInformation a
 parseTypeInformationFromMapping m =
  parseTypeInformation
    (\v -> maybe (Left $ "unknown value: " <> show v) Right . flip lookup reversedM $ v)
    (\v -> fromMaybe (error $ "forgot case: " <> show v) . flip lookup m $ v)
    typeInformation
  where
    reversedM = (\(x, y) -> (y, x)) <$> m
-deriving newtype instance ToField Action
+deriving via JSONBEncoded (Overrides l) instance (DBType (Overrides l))
-deriving newtype instance FromField DeploymentTag
+deriving newtype instance DBType DeploymentId
 deriving newtype instance DBEq DeploymentId
-deriving newtype instance ToField DeploymentTag
+deriving newtype instance DBType DeploymentName
 deriving newtype instance DBEq DeploymentName
-deriving newtype instance FromField DeploymentName
+deriving newtype instance DBType DeploymentTag
 deriving newtype instance DBEq DeploymentTag
-deriving newtype instance ToField DeploymentName
+instance DBType Action where
  typeInformation = parseTypeInformationFromMapping actionText
 deriving newtype instance DBType ArchivedFlag
 deriving newtype instance DBType Duration
 deriving newtype instance DBType Timestamp
 deriving newtype instance DBType ProjectName
 deriving anyclass instance DBEq DeploymentStatus
 instance DBType DeploymentStatus where
  typeInformation = parseTypeInformationFromMapping deploymentStatusText
 deriving via JSONBEncoded DeploymentMetadata instance DBType DeploymentMetadata
 deriving newtype instance DBType Stdout
 deriving newtype instance DBType Stderr
 deriving newtype instance DBType ActionId
 deriving newtype instance DBEq ActionId
--- a/octopod-backend/src/Types.hs
+++ b/octopod-backend/src/Types.hs
@ -25,15 +25,16 @@ import Data.Text as T
 import Data.Traversable
 import Common.Types
 import Data.Time
 -- | Parses deployment metadata.
-parseDeploymentMetadata :: [Text] -> IO [DeploymentMetadata]
+parseDeploymentMetadata :: [Text] -> IO DeploymentMetadata
-parseDeploymentMetadata texts =
+parseDeploymentMetadata texts = fmap DeploymentMetadata $
  for texts $ \t ->
    case T.findIndex (== ',') t of
      Just i -> do
        let (key, value) = bimap strip (T.tail . strip) $ T.splitAt i t
-        pure $ DeploymentMetadata key value
+        pure $ DeploymentMetadatum key value
      Nothing ->
        error $
          "Malformed metadata key-value pair " <> T.unpack t
@ -60,11 +61,11 @@ newtype Namespace = Namespace {unNamespace :: Text}
  deriving stock (Show)
 -- | Archive retention.
-newtype ArchiveRetention = ArchiveRetention {unArchiveRetention :: Int}
+newtype ArchiveRetention = ArchiveRetention {unArchiveRetention :: NominalDiffTime}
  deriving stock (Show)
 -- | Timeout.
-newtype Timeout = Timeout {unTimeout :: Int}
+newtype Timeout = Timeout {unTimeout :: CalendarDiffTime}
  deriving stock (Show)
 -- | Path to a deployment control script.
--- a/octopod-common/octopod-common.cabal
+++ b/octopod-common/octopod-common.cabal
@ -18,6 +18,7 @@ library
  exposed-modules:     Common.Types
                     , Common.Utils
                     , Common.Validation
                     , Data.Map.Ordered.Strict.Extra
  -- other-modules:
  -- other-extensions:
  default-extensions:  BlockArguments
@ -35,6 +36,16 @@ library
                     , TypeApplications
                     , TypeOperators
                     , ViewPatterns
                     , DeriveAnyClass
                     , OverloadedLabels
                     , StandaloneDeriving
                     , TypeSynonymInstances
                     , FlexibleInstances
                     , DataKinds
                     , KindSignatures
                     , EmptyDataDeriving
                     , TupleSections
                     , AllowAmbiguousTypes
  build-depends:       base
                     , aeson
                     , bytestring
@ -43,6 +54,9 @@ library
                     , http-api-data
                     , lens
                     , text
                     , containers
                     , time
                     , ordered-containers
  hs-source-dirs:      src
  default-language:    Haskell2010
  ghc-options:
@ -56,3 +70,4 @@ library
    -Wno-missing-local-signatures
    -Wno-partial-fields
    -Wno-unsafe
    -Wno-missed-specialisations
--- a/octopod-common/src/Common/Types.hs
+++ b/octopod-common/src/Common/Types.hs
@ -7,55 +7,87 @@
 -- This module contains common types between the backend and the frontend.
 module Common.Types where
-import Data.Bifunctor
+import Control.Lens
-import Data.Coerce
+import Data.Aeson hiding (Result)
-import Data.String
+import Data.Generics.Labels ()
-import Data.Text as T hiding (filter)
+import Data.Int
 import Data.Map.Ordered.Strict (OMap, (<>|))
 import qualified Data.Map.Ordered.Strict as OM
 import Data.Map.Ordered.Strict.Extra ()
 import Data.Maybe
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time
 import Data.Traversable
 import Deriving.Aeson
 import Deriving.Aeson.Stock
 import Web.HttpApiData
-- | Deployment override.
+data OverrideLevel = ApplicationLevel | DeploymentLevel
-data Override = Override
+
-  { overrideKey :: Text
+class KnownOverrideLevel (l :: OverrideLevel) where
-  , overrideValue :: Text
+  knownOverrideLevel :: OverrideLevel
-  , overrideVisibility :: OverrideVisibility
+
 instance KnownOverrideLevel 'ApplicationLevel where
  knownOverrideLevel = ApplicationLevel
 instance KnownOverrideLevel 'DeploymentLevel where
  knownOverrideLevel = DeploymentLevel
 data OverrideValue = ValueAdded Text | ValueDeleted
  deriving (ToJSON, FromJSON) via Snake OverrideValue
  deriving stock (Eq, Ord, Show, Generic)
 newtype DefaultConfig (l :: OverrideLevel) = DefaultConfig (OMap Text Text)
  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
 newtype Config (l :: OverrideLevel) = Config {unConfig :: OMap Text Text}
  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
 data FullDefaultConfig = FullDefaultConfig
  { appDefaultConfig :: DefaultConfig 'ApplicationLevel
  , depDefaultConfig :: DefaultConfig 'DeploymentLevel
  }
-  deriving stock (Generic, Show, Eq)
+  deriving stock (Show, Ord, Eq, Generic)
-  deriving (FromJSON, ToJSON) via Snake Override
+  deriving (ToJSON, FromJSON) via Snake FullDefaultConfig
-type Overrides = [Override]
+data FullConfig = FullConfig
  { appConfig :: Config 'ApplicationLevel
  , depConfig :: Config 'DeploymentLevel
  }
  deriving stock (Show, Ord, Eq, Generic)
  deriving (ToJSON, FromJSON) via Snake FullConfig
-- | Deployment override scope.
+applyOverrides :: Overrides l -> DefaultConfig l -> Config l
-data OverrideScope
+applyOverrides (Overrides oo) (DefaultConfig dd) =
-  = ApplicationScope
+  Config . extract $ oo <>| (ValueAdded <$> dd)
-  | DeploymentScope
+  where
-  deriving stock (Generic, Show, Read, Eq)
+    extract :: OMap Text OverrideValue -> OMap Text Text
-  deriving (FromJSON, ToJSON) via Snake OverrideScope
+    extract =
      fmap
        ( \case
            ValueAdded v -> v
            ValueDeleted -> error "invariant"
        )
        . OM.filter
          ( \_ -> \case
              ValueAdded _ -> True
              ValueDeleted -> False
          )
-- | Deployment override visibility.
+newtype Overrides (l :: OverrideLevel) = Overrides {unOverrides :: OMap Text OverrideValue}
-data OverrideVisibility
+  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
  = Private
  | Public
  deriving stock (Generic, Show, Read, Eq)
  deriving (FromJSON, ToJSON) via Snake OverrideVisibility
-- | Deployment application-level override.
+ov :: Text -> OverrideValue -> Overrides l
-newtype ApplicationOverride = ApplicationOverride {unApplicationOverride :: Override}
+ov k v = Overrides $ OM.singleton (k, v)
  deriving newtype (Show, Eq, FromJSON, ToJSON)
-- | Deployment application-level overrides.
+instance Semigroup (Overrides l) where
-type ApplicationOverrides = [ApplicationOverride]
+  (Overrides lhs) <> (Overrides rhs) = Overrides $ rhs <>| lhs
-- | Deployment-level override.
+instance Monoid (Overrides l) where
-newtype DeploymentOverride = DeploymentOverride
+  mempty = Overrides OM.empty
  {unDeploymentOverride :: Override}
  deriving newtype (Show, Eq, FromJSON, ToJSON)
-- | Deployment-level overrides.
+newtype DeploymentId = DeploymentId {unDeploymentId :: Int64}
 type DeploymentOverrides = [DeploymentOverride]
 newtype DeploymentId = DeploymentId {unDeploymentId :: Int}
  deriving stock (Show)
 newtype DeploymentName = DeploymentName {unDeploymentName :: Text}
@ -66,30 +98,47 @@ newtype DeploymentTag = DeploymentTag {unDeploymentTag :: Text}
  deriving newtype
    (Show, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData, Eq)
-newtype Action = Action {unAction :: Text}
+data Action = RestoreAction | ArchiveAction | UpdateAction | CreateAction
-  deriving newtype (Show, FromJSON, ToJSON, IsString)
+  deriving stock (Show, Read, Eq, Ord, Generic)
  deriving (FromJSON, ToJSON) via Snake Action
 actionText :: [(Action, Text)]
 actionText =
  [ (RestoreAction, "restore")
  , (ArchiveAction, "archive")
  , (UpdateAction, "update")
  , (CreateAction, "create")
  ]
 actionToText :: Action -> Text
 actionToText k = fromMaybe (error $ "forgot case: " <> show k) . Prelude.lookup k $ actionText
 newtype ArchivedFlag = ArchivedFlag {unArchivedFlag :: Bool}
  deriving newtype (Show, FromJSON, ToJSON)
-newtype Duration = Duration {unDuration :: Int}
+newtype Duration = Duration {unDuration :: CalendarDiffTime}
-  deriving newtype (Show, FromJSON, ToJSON)
+  deriving newtype (Show, Eq, FromJSON, ToJSON, FormatTime)
-newtype Timestamp = Timestamp {unTimestamp :: Int}
+newtype Timestamp = Timestamp {unTimestamp :: CalendarDiffTime}
-  deriving newtype (Show, Eq, Ord, FromJSON, ToJSON)
+  deriving newtype (Show, Eq, FromJSON, ToJSON)
 newtype ProjectName = ProjectName {uProjectName :: Text}
  deriving newtype (Show, FromJSON, ToJSON)
-deploymentStatusText :: DeploymentStatus -> Text
+deploymentStatusText :: [(DeploymentStatus, Text)]
-deploymentStatusText Running = "Running"
+deploymentStatusText =
-deploymentStatusText (Failure GenericFailure) = "GenericFailure"
+  [ (Running, "Running")
-deploymentStatusText (Failure TagMismatch) = "TagMismatch"
+  , (Failure GenericFailure, "GenericFailure")
-deploymentStatusText (Failure PartialAvailability) = "PartialAvailability"
+  , (Failure TagMismatch, "TagMismatch")
-deploymentStatusText CreatePending = "CreatePending"
+  , (Failure PartialAvailability, "PartialAvailability")
-deploymentStatusText UpdatePending = "UpdatePending"
+  , (CreatePending, "CreatePending")
-deploymentStatusText ArchivePending = "ArchivePending"
+  , (UpdatePending, "UpdatePending")
-deploymentStatusText Archived = "Archived"
+  , (ArchivePending, "ArchivePending")
  , (Archived, "Archived")
  ]
 deploymentStatusToText :: DeploymentStatus -> Text
 deploymentStatusToText k = fromMaybe (error $ "forgot case: " <> show k) . Prelude.lookup k $ deploymentStatusText
 data DeploymentStatus
  = Running
@ -124,8 +173,8 @@ isArchivedStatus = (`elem` archivedStatuses)
 data Deployment = Deployment
  { name :: DeploymentName
  , tag :: DeploymentTag
-  , appOverrides :: ApplicationOverrides
+  , appOverrides :: Overrides 'ApplicationLevel
-  , deploymentOverrides :: DeploymentOverrides
+  , deploymentOverrides :: Overrides 'DeploymentLevel
  }
  deriving stock (Generic, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake Deployment
@ -134,27 +183,30 @@ data DeploymentLog = DeploymentLog
  { actionId :: ActionId
  , action :: Action
  , deploymentTag :: DeploymentTag
-  , deploymentAppOverrides :: ApplicationOverrides
+  , deploymentAppOverrides :: Overrides 'ApplicationLevel
-  , deploymentDepOverrides :: DeploymentOverrides
+  , deploymentDepOverrides :: Overrides 'DeploymentLevel
-  , exitCode :: Int
+  , exitCode :: Int64
  , duration :: Duration
-  , createdAt :: Int
+  , createdAt :: UTCTime
  }
  deriving stock (Generic, Show)
  deriving (FromJSON, ToJSON) via Snake DeploymentLog
 data DeploymentMetadata = DeploymentMetadata
  { -- | The name of the link
    deploymentMetadataKey :: Text
  , -- | The URL
    deploymentMetadataValue :: Text
  }
  deriving stock (Generic, Show, Eq)
-  deriving (FromJSON, ToJSON) via Snake DeploymentMetadata
+  deriving (ToJSON, FromJSON) via Snake DeploymentLog
 newtype DeploymentMetadata = DeploymentMetadata {unDeploymentMetadata :: [DeploymentMetadatum]}
  deriving newtype (Eq, Show, Ord, FromJSON, ToJSON)
 data DeploymentMetadatum = DeploymentMetadatum
  { -- | The name of the link
    name :: Text
  , -- | The URL
    link :: Text
  }
  deriving stock (Generic, Show, Eq, Ord)
  deriving (FromJSON, ToJSON) via Snake DeploymentMetadatum
 data DeploymentInfo = DeploymentInfo
  { deployment :: Deployment
-  , metadata :: [DeploymentMetadata]
+  , metadata :: DeploymentMetadata
  , logs :: [DeploymentLog]
  }
  deriving stock (Generic, Show)
@ -163,13 +215,21 @@ data DeploymentInfo = DeploymentInfo
 data DeploymentFullInfo = DeploymentFullInfo
  { deployment :: Deployment
  , status :: PreciseDeploymentStatus
-  , metadata :: [DeploymentMetadata]
+  , metadata :: DeploymentMetadata
-  , createdAt :: Int
+  , createdAt :: UTCTime
-  , updatedAt :: Int
+  , updatedAt :: UTCTime
  , deploymentDefaultConfig :: FullDefaultConfig
  }
  deriving stock (Generic, Show, Eq)
  deriving (FromJSON, ToJSON) via Snake DeploymentFullInfo
 getDeploymentConfig :: DeploymentFullInfo -> FullConfig
 getDeploymentConfig d =
  FullConfig
    { appConfig = applyOverrides (d ^. #deployment . #appOverrides) (d ^. #deploymentDefaultConfig . #appDefaultConfig)
    , depConfig = applyOverrides (d ^. #deployment . #deploymentOverrides) (d ^. #deploymentDefaultConfig . #depDefaultConfig)
    }
 isDeploymentArchived :: DeploymentFullInfo -> Bool
 isDeploymentArchived DeploymentFullInfo {status = s} = case s of
  DeploymentNotPending s' -> isArchivedStatus s'
@ -179,27 +239,12 @@ isDeploymentArchived DeploymentFullInfo {status = s} = case s of
 data DeploymentUpdate = DeploymentUpdate
  { newTag :: DeploymentTag
-  , newAppOverrides :: ApplicationOverrides
+  , appOverrides :: Overrides 'ApplicationLevel
-  , oldAppOverrides :: ApplicationOverrides
+  , deploymentOverrides :: Overrides 'DeploymentLevel
  , newDeploymentOverrides :: DeploymentOverrides
  , oldDeploymentOverrides :: DeploymentOverrides
  }
  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
@ -225,7 +270,7 @@ data WSEvent = FrontendPleaseUpdateEverything
  deriving stock (Generic, Show)
  deriving (FromJSON, ToJSON) via Snake WSEvent
-newtype ActionId = ActionId {unActionId :: Int}
+newtype ActionId = ActionId {unActionId :: Int64}
  deriving newtype
    (Show, Read, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData, Eq)
@ -238,74 +283,36 @@ newtype Stderr = Stderr {unStderr :: Text}
  deriving (FromJSON, ToJSON) via Snake Stderr
 data ActionInfo = ActionInfo
-  { stdout :: Text
+  { stdout :: Stdout
-  , stderr :: Text
+  , stderr :: Stderr
  }
  deriving stock (Generic, Show)
  deriving (FromJSON, ToJSON) via Snake ActionInfo
 -- | Parses setting application-level overrides.
 parseSetApplicationOverrides ::
  OverrideVisibility ->
  [Text] ->
  IO [ApplicationOverride]
 parseSetApplicationOverrides visibility texts =
  coerce <$> parseSetOverrides visibility texts
 -- | Parses setting deployment-level overrides.
 parseSetDeploymentOverrides ::
  OverrideVisibility ->
  [Text] ->
  IO [DeploymentOverride]
 parseSetDeploymentOverrides visibility texts =
  coerce <$> parseSetOverrides visibility texts
 -- | Parses setting overrides.
-parseSetOverrides :: OverrideVisibility -> [Text] -> IO [Override]
+parseSetOverrides :: [Text] -> Either Text (Overrides l)
-parseSetOverrides visibility texts =
+parseSetOverrides texts = do
-  for texts $ \t ->
+  pairs' <- for texts $ \text -> case parseSingleOverride text of
-    case T.findIndex (== '=') t of
+    Just x -> Right x
      Just i -> do
        let (key, value) = bimap strip (T.tail . strip) $ T.splitAt i t
        pure $ Override key value visibility
    Nothing ->
-        error $
+      Left $ "Malformed override key-value pair " <> text <> ", should be similar to FOO=bar"
-          "Malformed override key-value pair " <> T.unpack t
+  return . Overrides $ OM.fromList pairs'
-            <> ", should be similar to FOO=bar"
+  where
    parseSingleOverride :: Text -> Maybe (Text, OverrideValue)
    parseSingleOverride t
      | Just i <- T.findIndex (== '=') t =
        let (key, value) = bimap T.strip (T.tail . T.strip) $ T.splitAt i t
         in Just (key, ValueAdded value)
    parseSingleOverride _ = Nothing
-- | Parses unsetting application-level overrides.
+parseUnsetOverrides :: [Text] -> Overrides l
-parseUnsetApplicationOverrides ::
+parseUnsetOverrides = Overrides . OM.fromList . fmap (,ValueDeleted)
  OverrideVisibility ->
  [Text] ->
  IO [ApplicationOverride]
 parseUnsetApplicationOverrides visibility texts =
  coerce <$> parseUnsetOverrides visibility texts
-- | Parses unsetting deployment-level overrides.
+formatOverrides :: Overrides l -> Text
-parseUnsetDeploymentOverrides ::
+formatOverrides = T.unlines . formatOverrides'
  OverrideVisibility ->
  [Text] ->
  IO [DeploymentOverride]
 parseUnsetDeploymentOverrides visibility texts =
  coerce <$> parseUnsetOverrides visibility texts
-- | Parses unsetting overrides.
+formatOverrides' :: Overrides l -> [Text]
-parseUnsetOverrides :: OverrideVisibility -> [Text] -> IO [Override]
+formatOverrides' (Overrides m) = fmap (\(k, v) -> k <> "=" <> showValue v) . OM.assocs $ m
-parseUnsetOverrides visibility texts =
+  where
-  for texts $ \key ->
+    showValue (ValueAdded v) = v
-    pure $ Override key "" visibility
+    showValue ValueDeleted = "<removed>"
 -- | Creates pretty-printed text from override.
 formatOverride :: Override -> Text
 formatOverride o@(Override _ _ vis) =
  overrideToArg o <> case vis of
    Private -> " (" <> pack (show vis) <> ")"
    Public -> mempty
 -- | Creates pretty-printed texts from overrides.
 formatOverrides :: Overrides -> Text
 formatOverrides = T.unlines . fmap formatOverride
 -- | Creates a CLI argument from an override.
 overrideToArg :: Override -> Text
 overrideToArg (Override k v _) = k <> "=" <> v
--- a/octopod-common/src/Common/Utils.hs
+++ b/octopod-common/src/Common/Utils.hs
@ -36,7 +36,7 @@ dfiName ::
  (DeploymentName -> f DeploymentName) ->
  DeploymentFullInfo ->
  f DeploymentFullInfo
-dfiName = field @"deployment" . field @"name"
+dfiName = field @"deployment" . field' @"name"
 -- | Checks that deployment status is pending.
 isPending :: DeploymentStatus -> Bool
--- a/octopod-common/src/Data/Map/Ordered/Strict/Extra.hs
+++ b/octopod-common/src/Data/Map/Ordered/Strict/Extra.hs
@ -0,0 +1,15 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Data.Map.Ordered.Strict.Extra
  (
  )
 where
 import Data.Aeson
 import Data.Map.Ordered.Strict
 instance (ToJSON k, ToJSON v) => ToJSON (OMap k v) where
  toJSON = toJSON . assocs
 instance (FromJSON k, FromJSON v, Ord k) => FromJSON (OMap k v) where
  parseJSON = fmap fromList . parseJSON
--- a/octopod-frontend/octopod-frontend.cabal
+++ b/octopod-frontend/octopod-frontend.cabal
@ -83,6 +83,7 @@ executable frontend
                     , FunctionalDependencies
                     , AllowAmbiguousTypes
                     , OverloadedLabels
                     , ViewPatterns
  build-depends:       aeson
                     , base
                     , bytestring
@ -104,5 +105,6 @@ executable frontend
                     , mtl
                     , semialign
                     , these
                     , ordered-containers
  hs-source-dirs:      src
  default-language:    Haskell2010
--- a/octopod-frontend/src/Frontend/Utils.hs
+++ b/octopod-frontend/src/Frontend/Utils.hs
@ -8,15 +8,23 @@
 --frontend modules.
 module Frontend.Utils where
 import Common.Types as CT
 import Control.Lens
 import Control.Monad
 import Control.Monad.Reader
 import Data.Functor
 import Data.Generics.Labels ()
 import qualified Data.List as L
 import Data.Map (Map)
 import qualified Data.Map as M
 import qualified Data.Map.Ordered.Strict as OM
 import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Proxy (Proxy (..))
-import Data.Text as T (Text, pack)
+import Data.Text as T (Text, null, pack)
 import Data.Time
 import Data.Time.Clock.POSIX
 import Frontend.GHCJS
 import GHCJS.DOM
 import GHCJS.DOM.Element as DOM
 import GHCJS.DOM.EventM (on, target)
@ -24,10 +32,6 @@ import GHCJS.DOM.GlobalEventHandlers as Events (click)
 import GHCJS.DOM.Node as DOM
 import Reflex.Dom as R
 import Common.Types as CT
 import Control.Monad.Reader
 import Frontend.GHCJS
 -- | Wrapper for @Maybe DOM.Element@. It's used by 'elementClick'.
 newtype ClickedElement = ClickedElement {unClickedElement :: Maybe DOM.Element}
@ -374,18 +378,13 @@ elDynAttrWithModifyConfig' f elementTag attrs child = do
  pure result
 -- | Formats posix seconds to date in iso8601.
-formatPosixToDate :: Int -> Text
+formatPosixToDate :: FormatTime t => t -> Text
-formatPosixToDate =
+formatPosixToDate = pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing)
  pack
    . formatTime defaultTimeLocale (iso8601DateFormat Nothing)
    . intToUTCTime
 -- | Formats posix seconds to date in iso8601 with time.
-formatPosixToDateTime :: Int -> Text
+formatPosixToDateTime :: FormatTime t => t -> Text
 formatPosixToDateTime =
-  pack
+  pack . formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S"))
    . formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S"))
    . intToUTCTime
 -- | Widget displaying the current deployment status.
 statusWidget :: MonadWidget t m => Dynamic t PreciseDeploymentStatus -> m ()
@ -487,9 +486,9 @@ errorCommonWidget =
 overridesWidget ::
  MonadWidget t m =>
  -- | List of overrides.
-  Overrides ->
+  Overrides l ->
  m ()
-overridesWidget envs = divClass "listing listing--for-text" $ do
+overridesWidget (Overrides (OM.assocs -> envs)) = divClass "listing listing--for-text" $ do
  let visible = take 3 envs
      envLength = length envs
  listing visible
@ -512,10 +511,12 @@ overridesWidget envs = divClass "listing listing--for-text" $ do
    blank
  where
    listing envs' = do
-      forM_ envs' $ \(Override var val _) ->
+      forM_ envs' $ \(var, val) ->
        divClass "listing__item" $ do
          el "b" $ text $ var <> ": "
-          text val
+          case val of
            ValueAdded v -> text v
            ValueDeleted -> el "i" $ text "<deleted>"
 -- | @if-then-else@ helper for cases when bool value is wrapped in 'Dynamic'.
 ifThenElseDyn ::
@ -572,3 +573,87 @@ kubeDashboardUrl deploymentInfo = do
  template <- asks kubernetesDashboardUrlTemplate
  let name = unDeploymentName . view (#deployment . #name) <$> deploymentInfo
  return $ name <&> (\n -> (<> n) <$> template)
 -- | Widget with override fields. This widget supports adding and
 -- removing key-value pairs.
 envVarsInput ::
  forall l t m.
  MonadWidget t m =>
  -- | Overrides header.
  Text ->
  -- | Current deployment overrides.
  Overrides l ->
  -- | Updated deployment overrides.
  m (Dynamic t (Overrides l))
 envVarsInput overridesHeader (Overrides evs) = do
  elClass "section" "deployment__section" $ do
    elClass "h3" "deployment__sub-heading" $ text overridesHeader
    elClass "div" "deployment__widget" $
      elClass "div" "overrides" $ mdo
        let initEnvs =
              L.foldl'
                ( \m -> \case
                    (k, ValueAdded v) -> fst $ insertUniq (k, v) m
                    (_, ValueDeleted) -> m
                )
                emptyUniqKeyMap
                . OM.assocs
                $ evs
            toOverrides :: [Override] -> Overrides l
            toOverrides = Overrides . OM.fromList . (fmap . fmap) ValueAdded
            emptyVar = ("", "")
            addEv = clickEv $> Endo (fst . insertUniq emptyVar)
        envsDyn <- foldDyn appEndo initEnvs $ leftmost [addEv, updEv]
        (_, updEv) <- runEventWriterT $ listWithKey (uniqMap <$> envsDyn) envVarInput
        let addingIsEnabled = all ((not . T.null) . fst) . elemsUniq <$> envsDyn
        clickEv <-
          buttonClassEnabled'
            "overrides__add dash dash--add"
            "Add an override"
            addingIsEnabled
            "dash--disabled"
        pure $ toOverrides . elemsUniq <$> envsDyn
 -- | Widget for entering a key-value pair. The updated overrides list is
 -- written to the 'EventWriter'.
 envVarInput ::
  (EventWriter t (Endo (UniqKeyMap Override)) m, MonadWidget t m) =>
  -- | Index of variable in overrides list.
  Int ->
  -- | Current variable key and value.
  Dynamic t Override ->
  m ()
 envVarInput i epDyn = do
  ep <- sample $ current epDyn
  divClass "overrides__item" $ do
    (keyDyn, _) <-
      octopodTextInput' "overrides__key" "key" (Just $ fst ep) never
    (valDyn, _) <-
      octopodTextInput' "overrides__value" "value" (Just $ snd ep) never
    closeEv <- buttonClass "overrides__delete spot spot--cancel" "Delete"
    let envEv = updated $ zipDynWith (,) keyDyn valDyn
        deleteEv = Endo (deleteUniq i) <$ closeEv
        updEv = Endo . updateUniq i . const <$> envEv
    tellEvent $ leftmost [deleteEv, updEv]
 data UniqKeyMap v = UniqKeyMap (Map Int v) Int
 uniqMap :: UniqKeyMap v -> Map Int v
 uniqMap (UniqKeyMap m _) = m
 insertUniq :: v -> UniqKeyMap v -> (UniqKeyMap v, Int)
 insertUniq v (UniqKeyMap m x) = (UniqKeyMap (M.insert x v m) (x + 1), x)
 deleteUniq :: Int -> UniqKeyMap v -> UniqKeyMap v
 deleteUniq k (UniqKeyMap m x) = UniqKeyMap (M.delete k m) x
 updateUniq :: Int -> (v -> v) -> UniqKeyMap v -> UniqKeyMap v
 updateUniq k f (UniqKeyMap m x) = UniqKeyMap (M.adjust f k m) x
 elemsUniq :: UniqKeyMap v -> [v]
 elemsUniq (UniqKeyMap m _) = M.elems m
 emptyUniqKeyMap :: UniqKeyMap v
 emptyUniqKeyMap = UniqKeyMap mempty 0
 type Override = (Text, Text)
--- a/octopod-frontend/src/Main.hs
+++ b/octopod-frontend/src/Main.hs
@ -22,6 +22,7 @@ import Frontend.Utils (errorCommonWidget, loadingCommonWidget)
 import Page.Deployment
 import Page.Deployments
 main :: IO ()
 main = mdo
  mainWidgetWithHead'
--- a/octopod-frontend/src/Page/Deployment.hs
+++ b/octopod-frontend/src/Page/Deployment.hs
@ -1,17 +1,15 @@
-{-|
+-- |
-Module      : Page.Deployment
+--Module      : Page.Deployment
-Description : Deployment page.
+--Description : Deployment page.
-
+--
-This module contains the definition of a deployment page.
+--This module contains the definition of a deployment page.
 -}
 module Page.Deployment (deploymentPage) where
 import Control.Lens
 import Control.Monad
 import Data.Coerce
 import Data.Generics.Product (field)
-import           Data.Text as T (Text)
+import Data.Text as T (Text, pack)
 import Obelisk.Route.Frontend
 import Reflex.Dom as R
 import Servant.Reflex
@ -21,6 +19,8 @@ import           Common.Utils
 import Control.Monad.Reader
 import Data.Align
 import Data.Generics.Labels ()
 import qualified Data.Map.Ordered.Strict as OM
 import Data.Time
 import Frontend.API
 import Frontend.GHCJS
 import Frontend.Route
@ -33,50 +33,57 @@ import           Servant.Reflex.Extra
 -- | The root widget of a deployment page. It requests the deployment data.
 -- If the request fails it shows an error,
 -- otherwise it calls 'deploymentWidget', passing the received data.
-deploymentPage
+deploymentPage ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
  , Prerender js t m
  , MonadReader ProjectConfig m
-    )
+  ) =>
-  => Event t ()     -- ^ Event notifying about the need to update data.
+  -- | Event notifying about the need to update data.
-  -> DeploymentName -- ^ Name of current deployment.
+  Event t () ->
-  -> m ()
+  -- | Name of current deployment.
  DeploymentName ->
  m ()
 deploymentPage updAllEv dname = do
  pb <- getPostBuild
  respEv <- fullInfoEndpoint (constDyn $ Right dname) pb
  let (okEv, errEv) = processResp respEv
-  widgetHold_ (loadingWidget dname) $ leftmost
+  widgetHold_ (loadingWidget dname) $
    leftmost
      [ errorWidget dname <$ errEv
-    , deploymentWidget updAllEv <$> okEv ]
+      , deploymentWidget updAllEv <$> okEv
      ]
 -- | Deployment page widget that takes the initial deployment data.
 -- It updates this data every time when the passed event fires.
 -- If an update fails, a notification widget appears at the top of the page.
-deploymentWidget
+deploymentWidget ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
  , Prerender js t m
  , MonadReader ProjectConfig m
-    )
+  ) =>
-  => Event t ()         -- ^ Event notifying about the need to update data.
+  -- | Event notifying about the need to update data.
-  -> DeploymentFullInfo -- ^ Initial deployment data.
+  Event t () ->
-  -> m ()
+  -- | Initial deployment data.
  DeploymentFullInfo ->
  m ()
 deploymentWidget updEv dfi = mdo
  editEv <- pageWrapper $ mdo
    retryEv <- delay 10 errEv
-    respEv <- fullInfoEndpoint (constDyn $ Right $ dfi ^. dfiName)
+    respEv <-
-      $ leftmost [ updEv, retryEv ]
+      fullInfoEndpoint (constDyn $ Right $ dfi ^. dfiName) $
        leftmost [updEv, retryEv]
    let (okEv, errEv) = processResp respEv
    dfiDyn <- holdDyn dfi okEv
    editEv' <- deploymentHead dfiDyn sentEv
-    pageNotification $ leftmost
+    pageNotification $
      leftmost
        [ DPMError "Couldn't update status of deployment" <$ errEv
-      , DPMClear <$ okEv ]
+        , DPMClear <$ okEv
        ]
    deploymentBody updEv dfiDyn
    pure editEv'
  sentEv <- editDeploymentPopup editEv never
@ -89,23 +96,27 @@ deploymentWidget updEv dfi = mdo
 --    and \"edit deployment\" buttons.
 -- If the status is pending (\"Creating\", \"Updating\", etc)
 -- then all buttons are inactive.
-deploymentHead
+deploymentHead ::
-  :: (MonadWidget t m, MonadReader ProjectConfig m)
+  (MonadWidget t m, MonadReader ProjectConfig m) =>
-  => Dynamic t DeploymentFullInfo
+  -- | Deployment data.
-  -- ^ Deployment data.
+  Dynamic t DeploymentFullInfo ->
-  -> Event t Bool
+  -- | Event with a flag showing the current state of the request.
-  -- ^ Event with a flag showing the current state of the request.
+  Event t Bool ->
-  -> m (Event t DeploymentFullInfo)
+  -- | \"Edit\" event.
-  -- ^ \"Edit\" event.
+  m (Event t DeploymentFullInfo)
 deploymentHead dfiDyn sentEv =
  divClass "page__head" $ do
    let dname = dfiDyn <^.> dfiName . coerced
    elClass "h1" "page__heading title" $ dynText dname
-    (editEv, archEv) <- hold2 . dyn $ dfiDyn <&> \dfi -> if isDeploymentArchived dfi
+    (editEv, archEv) <-
      hold2 . dyn $
        dfiDyn <&> \dfi ->
          if isDeploymentArchived dfi
            then mdo
              let btnState = not $ isPending . recordedStatus $ dfi ^. field @"status"
-        btnEnabledDyn <- holdDyn btnState $ leftmost [ False <$ btnEv, sentEv ]
+              btnEnabledDyn <- holdDyn btnState $ leftmost [False <$ btnEv, sentEv]
-        btnEv <- aButtonClassEnabled
+              btnEv <-
                aButtonClassEnabled
                  "page__action button button--secondary button--restore \
                  \classic-popup-handler"
                  "Recover from archive"
@ -115,12 +126,14 @@ deploymentHead dfiDyn sentEv =
            else mdo
              let btnState = not $ isPending . recordedStatus $ dfi ^. field @"status"
              btnEnabledDyn <- holdDyn btnState $ not <$> sentEv
-        editEv <- buttonClassEnabled'
+              editEv <-
                buttonClassEnabled'
                  "page__action button button--edit popup-handler"
                  "Edit deployment"
                  btnEnabledDyn
                  "button--disabled"
-        archEv <- buttonClassEnabled'
+              archEv <-
                buttonClassEnabled'
                  "page__action button button--secondary button--archive \
                  \classic-popup-handler"
                  "Move to archive"
@ -128,8 +141,13 @@ deploymentHead dfiDyn sentEv =
                  "button--disabled"
              pure (R.tag (current dfiDyn) editEv, archEv)
    url' <- kubeDashboardUrl dfiDyn
-    void . dyn $ url' <&> maybe blank (\url ->
+    void . dyn $
-      void $ aButtonDynClass'
+      url'
        <&> maybe
          blank
          ( \url ->
              void $
                aButtonDynClass'
                  "page__action button button--secondary button--logs"
                  "Details"
                  (pure $ "href" =: url <> "target" =: "_blank")
@ -142,10 +160,10 @@ deploymentHead dfiDyn sentEv =
    void $ archiveEndpoint (Right . coerce <$> dname) delEv
    return editEv
-hold2
+hold2 ::
-  :: (MonadHold t m, Reflex t)
+  (MonadHold t m, Reflex t) =>
-  =>  m (Event t (Event t a, Event t b))
+  m (Event t (Event t a, Event t b)) ->
-  -> m (Event t a, Event t b)
+  m (Event t a, Event t b)
 hold2 = (>>= fmap fanThese . switchHold never . fmap (uncurry align))
 -- | Div wrappers.
@ -153,15 +171,16 @@ deploymentBodyWrapper :: MonadWidget t m => m a -> m a
 deploymentBodyWrapper m = divClass "page__body" $ divClass "deployment" $ m
 -- | Body of a deployment page.
-deploymentBody
+deploymentBody ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t ()
+  -- | Event notifying about the need to update data.
-  -- ^ Event notifying about the need to update data.
+  Event t () ->
-  -> Dynamic t DeploymentFullInfo
+  -- | Deployment data.
-  -- ^ Deployment data.
+  Dynamic t DeploymentFullInfo ->
-  -> m ()
+  m ()
 deploymentBody updEv dfiDyn = deploymentBodyWrapper $ do
  let nameDyn = dfiDyn <^.> dfiName
      cfg = dfiDyn <&> getDeploymentConfig
  divClass "deployment__summary" $ do
    divClass "deployment__stat" $ do
      elClass "b" "deployment__param" $ text "Status"
@ -182,20 +201,16 @@ deploymentBody updEv dfiDyn = deploymentBodyWrapper $ do
    elClass "h3" "deployment__sub-heading" $ text "Tag"
    divClass "deployment__widget" $ dynText tagDyn
  elClass "section" "deployment__section" $ do
-    let urlsDyn = dfiDyn <^.> field @"metadata"
+    let urlsDyn = dfiDyn <^.> field @"metadata" . to unDeploymentMetadata
    elClass "h3" "deployment__sub-heading" $ text "Links"
    divClass "deployment__widget" $
      divClass "listing" $
        void $ simpleList urlsDyn renderMetadataLink
  elClass "section" "deployment__section" $ do
-    let
+    let envsDyn = cfg <^.> #appConfig
      envsDyn = dfiDyn <^.> field @"deployment"
        . field @"appOverrides" . coerced
    allEnvsWidget "App overrides" envsDyn
  elClass "section" "deployment__section" $ do
-    let
+    let envsDyn = cfg <^.> #depConfig
      envsDyn = dfiDyn <^.> field @"deployment"
        . field @"deploymentOverrides" . coerced
    allEnvsWidget "Deployment overrides" envsDyn
  elClass "section" "deployment__section" $ do
    elClass "h3" "deployment__sub-heading" $ text "Actions"
@ -204,46 +219,49 @@ deploymentBody updEv dfiDyn = deploymentBodyWrapper $ do
        actionsTable updEv nameDyn
 -- | Widget that shows overrides list. It does not depend on their type.
-allEnvsWidget
+allEnvsWidget ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Text                -- ^ Widget header.
+  -- | Widget header.
-  -> Dynamic t Overrides -- ^ Overrides list.
+  Text ->
-  -> m ()
+  -- | Overrides list.
  Dynamic t (Config l) ->
  m ()
 allEnvsWidget headerText envsDyn = do
  elClass "h3" "deployment__sub-heading" $ text headerText
  divClass "deployment__widget" $
    divClass "listing listing--for-text listing--larger" $
-      void $ simpleList envsDyn $ \envDyn -> do
+      void $
-        let
+        simpleList (OM.assocs . unConfig <$> envsDyn) $ \envDyn -> do
-          varDyn = overrideKey <$> envDyn
+          let varDyn = fst <$> envDyn
-          valDyn = overrideValue <$> envDyn
+              valDyn = snd <$> envDyn
          divClass "listing__item" $ do
            el "b" $ do
              dynText varDyn
              text ": "
            dynText valDyn
 -- ^ Widget with a table of actions that can be performed on a deployment.
 -- It requests deployment data.
 -- If a request fails it shows an error message,
 -- otherwise it calls 'actionsTableData', passing the received data.
-actionsTable
+
-  :: MonadWidget t m
+actionsTable ::
-  => Event t ()
+  MonadWidget t m =>
-  -- ^ Event notifying about the need to update data.
+  -- | Event notifying about the need to update data.
-  -> Dynamic t DeploymentName
+  Event t () ->
-  -> m ()
+  Dynamic t DeploymentName ->
  m ()
 actionsTable updEv nameDyn = do
  pb <- getPostBuild
  respEv <- infoEndpoint (Right <$> nameDyn) pb
-  let
+  let okEv = join . fmap logs <$> fmapMaybe reqSuccess respEv
    okEv = join . fmap logs <$> fmapMaybe reqSuccess respEv
      errEv = fmapMaybe reqErrorBody respEv
  el "table" $ do
    actionsTableHead
-    widgetHold_ actionsTableLoading $ leftmost
+    widgetHold_ actionsTableLoading $
      leftmost
        [ actionsTableError <$ errEv
-      , actionsTableData updEv nameDyn <$> okEv ]
+        , actionsTableData updEv nameDyn <$> okEv
        ]
 -- | Header of the actions table.
 actionsTableHead :: MonadWidget t m => m ()
@ -268,7 +286,7 @@ actionsTableLoading = do
          text "Loading..."
 -- | Widget with an error message for the actions table.
-actionsTableError:: MonadWidget t m => m ()
+actionsTableError :: MonadWidget t m => m ()
 actionsTableError = do
  el "tbody" $
    elClass "tr" "no-table" $
@ -279,73 +297,68 @@ actionsTableError = do
 -- | Actions table body.
 -- It updates data every time when the supplied event fires.
-actionsTableData
+actionsTableData ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t ()
+  -- | Event notifying about the need to update data.
-  -- ^ Event notifying about the need to update data.
+  Event t () ->
-  -> Dynamic t DeploymentName
+  Dynamic t DeploymentName ->
-  -> [DeploymentLog]
+  -- | Initial logs.
-  -- ^ Initial logs.
+  [DeploymentLog] ->
-  -> m ()
+  m ()
 actionsTableData updEv nameDyn initLogs = do
  respEv <- infoEndpoint (Right <$> nameDyn) updEv
-  let
+  let okEv = join . fmap logs <$> fmapMaybe reqSuccess respEv
    okEv = join . fmap logs <$> fmapMaybe reqSuccess respEv
  logsDyn <- holdDyn initLogs okEv
  el "tbody" $
-    void $ simpleList logsDyn $ \logDyn -> do
+    void $
      simpleList logsDyn $ \logDyn -> do
        dyn_ $ actinRow <$> logDyn
 -- | Data row of the actions table.
 actinRow :: MonadWidget t m => DeploymentLog -> m ()
-actinRow DeploymentLog{..} = do
+actinRow DeploymentLog {..} = do
  el "tr" $ do
    el "td" $ do
-      text $ coerce action
+      text $ actionToText action
-      let
+      let statusClass =
-        statusClass = "status " <>
+            "status "
-          if exitCode == 0 then "status--success" else "status--failure"
+              <> if exitCode == 0 then "status--success" else "status--failure"
      divClass statusClass blank
    el "td" $ text $ coerce deploymentTag
-    el "td" $ overridesWidget $ coerce $ deploymentAppOverrides
+    el "td" $ overridesWidget $ deploymentAppOverrides
-    el "td" $ overridesWidget $ coerce $ deploymentDepOverrides
+    el "td" $ overridesWidget $ deploymentDepOverrides
    el "td" $ text $ showT $ exitCode
    el "td" $ text $ formatPosixToDateTime createdAt
    el "td" $ text $ formatDuration duration
 -- | Formats posix seconds to date in iso8601 with time.
 formatDuration :: FormatTime t => t -> Text
 formatDuration = pack . formatTime defaultTimeLocale "%mm %Ss"
 -- | Convert the duration of an action from milliseconds
 -- to a human readable format.
 formatDuration
  :: Duration -- ^ Duration in milliseconds.
  -> Text
 formatDuration (Duration d) = m <> "m " <> s <> "s"
  where
    m = showT $ d `div` (1000 * 60)
    s = showT $ d `div` (1000)
 -- | Widget with a button that returns to deployments list page.
-backButton
+backButton ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
-    , Prerender js t m )
+  , Prerender js t m
-  => m ()
+  ) =>
  m ()
 backButton = do
-  let
+  let backRoute = constDyn $ DashboardRoute :/ Nothing
    backRoute = constDyn $ DashboardRoute :/ Nothing
      attrs = constDyn $ "class" =: "page__back dash dash--back dash--smaller"
  routeLinkDynAttr attrs backRoute $ text "All deployments"
 -- | Widget with a loading spinner.
-loadingWidget
+loadingWidget ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
-    , Prerender js t m)
+  , Prerender js t m
-  => DeploymentName
+  ) =>
-  -> m ()
+  DeploymentName ->
  m ()
 loadingWidget dname = pageWrapper $ do
  divClass "page__head" $
    elClass "h1" "page__heading title" $ text $ coerce dname
@ -354,14 +367,14 @@ loadingWidget dname = pageWrapper $ do
      loadingCommonWidget
 -- | Widget with an error placeholder.
-errorWidget
+errorWidget ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
-    , Prerender js t m)
+  , Prerender js t m
-  => DeploymentName
+  ) =>
-  -> m ()
+  DeploymentName ->
  m ()
 errorWidget dname = pageWrapper $ do
  divClass "page__head" $
    elClass "h1" "page__heading title" $ text $ coerce dname
@ -370,14 +383,15 @@ errorWidget dname = pageWrapper $ do
      errorCommonWidget
 -- | Div wrappers.
-pageWrapper
+pageWrapper ::
  ::
  ( MonadWidget t m
  , RouteToUrl (R Routes) m
  , SetRoute t (R Routes) m
-    , Prerender js t m)
+  , Prerender js t m
-  => m a
+  ) =>
-  -> m a
+  m a ->
-pageWrapper m = divClass "page" $ divClass "page__wrap container" $ do
+  m a
 pageWrapper m = divClass "page" $
  divClass "page__wrap container" $ do
    backButton
    m
--- a/octopod-frontend/src/Page/Deployments.hs
+++ b/octopod-frontend/src/Page/Deployments.hs
@ -292,7 +292,9 @@ activeDeploymentWidget clickedEv dDyn' = do
        el "td" $ do
          name
          statusWidget $ constDyn status
-        el "td" $ divClass "listing" $ forM_ metadata (renderMetadataLink . pure)
+        el "td" $
          divClass "listing" $
            forM_ (unDeploymentMetadata metadata) (renderMetadataLink . pure)
        el "td" tag'
        el "td" $
          overridesWidget $ deployment ^. field @"appOverrides" . coerced
--- a/octopod-frontend/src/Page/Elements/Links.hs
+++ b/octopod-frontend/src/Page/Elements/Links.hs
@ -1,23 +1,26 @@
 module Page.Elements.Links
-  ( renderMetadataLink
+  ( renderMetadataLink,
-  ) where
+  )
 where
 import Common.Types
-import           Data.Functor
+import Control.Lens
 import qualified Data.Text as T
 import Reflex.Dom
-renderMetadataLink
+renderMetadataLink ::
-  :: (DomBuilder t m, PostBuild t m)
+  (DomBuilder t m, PostBuild t m) =>
-  => Dynamic t DeploymentMetadata -> m ()
+  Dynamic t DeploymentMetadatum ->
  m ()
 renderMetadataLink metadataD = do
-  let
+  let attrDyn =
-    attrDyn = metadataD <&> \metadata ->
+        metadataD <&> \metadata ->
          "class" =: "listing__item external bar bar--larger"
-      <> "href" =: deploymentMetadataValue metadata
+            <> "href" =: metadata ^. #link
            <> "target" =: "_blank"
-  elDynAttr "a" attrDyn . dynText $ metadataD <&> \case
+  elDynAttr "a" attrDyn . dynText $
    metadataD <&> \case
      -- If the name is empty, then use the url
-    DeploymentMetadata {deploymentMetadataKey = name}
+      DeploymentMetadatum {name = name}
        | (not . T.null . T.strip) name -> name
-    DeploymentMetadata {deploymentMetadataValue = url} -> url
+      DeploymentMetadatum {link = url} -> url
--- a/octopod-frontend/src/Page/Popup/EditDeployment.hs
+++ b/octopod-frontend/src/Page/Popup/EditDeployment.hs
@ -1,10 +1,8 @@
-{-|
+-- |
-Module      : Page.Popup.EditDeployment
+--Module      : Page.Popup.EditDeployment
-Description : Edit deployment sidebar.
+--Description : Edit deployment sidebar.
-
+--
-This module contains the definition of the "edit deployment" sidebar.
+--This module contains the definition of the "edit deployment" sidebar.
 -}
 module Page.Popup.EditDeployment (editDeploymentPopup) where
 import Control.Lens (coerced, preview, to, (^.), _2)
@ -13,13 +11,10 @@ import           Data.Coerce
 import Data.Functor
 import Data.Generics.Product
 import Data.Generics.Sum
 import           Data.List (deleteFirstsBy)
 import qualified Data.List as L
 import           Data.Map as M
 import Data.Monoid
 import qualified Data.Text as T
 import Reflex.Dom as R hiding (mapMaybe)
 import Prelude as P
 import           Reflex.Dom as R
 import Common.Types
 import Common.Utils
@ -30,61 +25,69 @@ import           Servant.Reflex
 import Servant.Reflex.Extra
 -- | The root function for \"edit deployment\" sidebar.
-editDeploymentPopup
+editDeploymentPopup ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t DeploymentFullInfo
+  -- | \"Show\" event carrying an editable sidebar.
-  -- ^ \"Show\" event carrying an editable sidebar.
+  Event t DeploymentFullInfo ->
-  -> Event t ()
+  -- | \"Close\" event.
-  -- ^ \"Close\" event.
+  Event t () ->
-  -> m (Event t Bool)
+  -- | Event with a flag showing the current state of the request.
-  -- ^ Event with a flag showing the current state of the request.
+  m (Event t Bool)
 editDeploymentPopup showEv hideEv = sidebar showEv hideEv $ \dfi -> mdo
  divClass "popup__body" $ mdo
    let dname = dfi ^. dfiName
    (closeEv', saveEv) <- editDeploymentPopupHeader dname enabledDyn
    (deploymentDyn, validDyn) <- editDeploymentPopupBody dfi respEv
-    respEv <- updateEndpoint (constDyn $ Right dname)
+    respEv <-
-      (Right <$> deploymentDyn) saveEv
+      updateEndpoint
-    sentDyn <- holdDyn False $ leftmost
+        (constDyn $ Right dname)
        (Right <$> deploymentDyn)
        saveEv
    sentDyn <-
      holdDyn False $
        leftmost
          [ True <$ saveEv
-      , False <$ respEv ]
+          , False <$ respEv
-    let
+          ]
-      successEv =
+    let successEv =
          fmapMaybe (preview (_Ctor @"Success") <=< commandResponse) respEv
-      closeEv = leftmost [ closeEv', successEv ]
+        closeEv = leftmost [closeEv', successEv]
        enabledDyn = zipDynWith (&&) (not <$> sentDyn) validDyn
    pure (updated sentDyn, closeEv)
 -- | The header of the sidebar contains the deployment name and control buttons:
 -- \"Save\" and \"Close\".
-editDeploymentPopupHeader
+editDeploymentPopupHeader ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => DeploymentName             -- ^ Name of the deployment.
+  -- | Name of the deployment.
-  -> Dynamic t Bool             -- ^ Form validation state.
+  DeploymentName ->
-  -> m (Event t (), Event t ()) -- ^ \"Close\" event and \"Save\" click event.
+  -- | Form validation state.
  Dynamic t Bool ->
  -- | \"Close\" event and \"Save\" click event.
  m (Event t (), Event t ())
 editDeploymentPopupHeader dname validDyn =
  divClass "popup__head" $ do
    closeEv <- buttonClass "popup__close" "Close popup"
    elClass "h2" "popup__project" $ text $ "Edit " <> coerce dname
-    saveEv <- divClass "popup__operations" $
+    saveEv <-
      divClass "popup__operations" $
        buttonClassEnabled "popup__action button button--save" "Save" validDyn
    divClass "popup__menu drop drop--actions" blank
    pure (closeEv, saveEv)
 -- | The body of the sidebar containing the edit form. Contains a tag field and
 -- an override field.
-editDeploymentPopupBody
+editDeploymentPopupBody ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => DeploymentFullInfo
+  -- | Full deployment data.
-  -- ^ Full deployment data.
+  DeploymentFullInfo ->
-  -> Event t (ReqResult tag CommandResponse)
+  -- | \"Edit request\" failure event.
-  -- ^ \"Edit request\" failure event.
+  Event t (ReqResult tag CommandResponse) ->
-  -> m (Dynamic t DeploymentUpdate, Dynamic t Bool)
+  -- | Returns deployment update and validation state.
-  -- ^ Returns deployment update and validation state.
+  m (Dynamic t DeploymentUpdate, Dynamic t Bool)
 editDeploymentPopupBody dfi errEv = divClass "popup__content" $
  divClass "deployment" $ mdo
-    let
+    let commandResponseEv = fmapMaybe commandResponse errEv
      commandResponseEv = fmapMaybe commandResponse errEv
        appErrEv = R.difference (fmapMaybe reqErrorBody errEv) commandResponseEv
        dfiTag = dfi ^. field @"deployment" . field @"tag" . coerced . to Just
        dfiAppVars = dfi ^. field @"deployment" . field @"appOverrides" . coerced
@ -95,101 +98,31 @@ editDeploymentPopupBody dfi errEv = divClass "popup__content" $
    (tagDyn, tOkEv) <- octopodTextInput "tag" "Tag" "Tag" dfiTag tagErrEv
    appVarsDyn <- envVarsInput "App overrides" dfiAppVars
    deploymentVarsDyn <- envVarsInput "Deployment overrides" dfiDeploymentVars
    let
      oldAppVarDyn = coerce <$> getOldVars dfiAppVars <$> appVarsDyn
      newAppVarDyn = coerce <$> getNewVars dfiAppVars <$> appVarsDyn
      oldDeploymentVarDyn = coerce <$> getOldVars dfiDeploymentVars <$> deploymentVarsDyn
      newDeploymentVarDyn = coerce <$> getNewVars dfiDeploymentVars <$> deploymentVarsDyn
    validDyn <- holdDyn True $ updated tOkEv
-    pure $ (DeploymentUpdate
+    pure
      ( DeploymentUpdate
          <$> (DeploymentTag <$> tagDyn)
-      <*> newAppVarDyn
+          <*> appVarsDyn
-      <*> oldAppVarDyn
+          <*> deploymentVarsDyn
-      <*> newDeploymentVarDyn
+      , validDyn
-      <*> oldDeploymentVarDyn, validDyn)
+      )
  where
-    getTagError crEv tagDyn = let
+    getTagError crEv tagDyn =
-      tagErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _2 )) crEv
+      let tagErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _2)) crEv
          tagErrEv = ffilter (/= "") $ T.intercalate ". " <$> tagErrEv'
          badTagText = "Tag should not be empty"
-      badNameEv = badTagText <$ (ffilter (== "") $ updated tagDyn)
+          badNameEv = badTagText <$ ffilter (== "") (updated tagDyn)
       in leftmost [tagErrEv, badNameEv]
    getOldVars i u = deleteFirstsBy cmpKey i u
    getNewVars i u = deleteFirstsBy (==) u i
    cmpKey (Override k1 _ v1) (Override k2 _ v2) = k1 == k2 && v1 == v2
 -- | The widget used to display errors.
-errorHeader
+errorHeader ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t Text -- ^ Message text.
+  -- | Message text.
-  -> m ()
+  Event t Text ->
  m ()
 errorHeader appErrEv = do
-  widgetHold_ blank $ appErrEv <&> \appErr -> do
+  widgetHold_ blank $
    appErrEv <&> \appErr -> do
      divClass "deployment__output notification notification--danger" $ do
        el "b" $ text "App error: "
        text appErr
 -- | Widget with override fields. This widget supports adding and
 -- removing key-value pairs.
 envVarsInput
  :: MonadWidget t m
  => Text                    -- ^ Overrides header.
  -> Overrides               -- ^ Current deployment overrides.
  -> m (Dynamic t Overrides) -- ^ Updated deployment overrides.
 envVarsInput overridesHeader evs = do
  elClass "section" "deployment__section" $ do
    elClass "h3" "deployment__sub-heading" $ text overridesHeader
    elClass "div" "deployment__widget" $
      elClass "div" "overrides" $ mdo
        let
          initEnvs = L.foldl' (\m v -> fst $ insertUniq v m) emptyUniqKeyMap evs
          emptyVar = Override "" "" Public
          addEv = clickEv $> Endo (fst . insertUniq emptyVar)
        envsDyn <- foldDyn appEndo initEnvs $ leftmost [ addEv, updEv ]
        (_, updEv)  <- runEventWriterT $ listWithKey (uniqMap <$> envsDyn) envVarInput
        let addingIsEnabled = all ( (not . T.null) . overrideKey ) . elemsUniq <$> envsDyn
        clickEv <- buttonClassEnabled'
          "overrides__add dash dash--add" "Add an override" addingIsEnabled
          "dash--disabled"
        pure $ elemsUniq <$> envsDyn
 -- | Widget for entering a key-value pair. The updated overrides list is
 -- written to the 'EventWriter'.
 envVarInput
  :: (EventWriter t (Endo (UniqKeyMap Override)) m, MonadWidget t m)
  => Int                -- ^ Index of variable in overrides list.
  -> Dynamic t Override -- ^ Current variable key and value.
  -> m ()
 envVarInput ix epDyn = do
  ep <- sample $ current epDyn
  divClass "overrides__item" $ do
    (keyDyn, _) <-
      octopodTextInput' "overrides__key" "key" (Just $ overrideKey ep) never
    (valDyn, _) <-
      octopodTextInput' "overrides__value" "value" (Just $ overrideValue ep) never
    closeEv <- buttonClass "overrides__delete spot spot--cancel" "Delete"
    let
      envEv = updated $ zipDynWith (\k v -> Override k v Public) keyDyn valDyn
      deleteEv = Endo (deleteUniq ix) <$ closeEv
      updEv = Endo . updateUniq ix . const <$> envEv
    tellEvent $ leftmost [deleteEv, updEv]
 data UniqKeyMap v = UniqKeyMap (Map Int v) (Int)
 uniqMap :: UniqKeyMap v -> Map Int v
 uniqMap (UniqKeyMap m _) = m
 insertUniq :: v -> UniqKeyMap v -> (UniqKeyMap v, Int)
 insertUniq v (UniqKeyMap m x) = (UniqKeyMap (M.insert x v m) (x + 1), x)
 deleteUniq :: Int -> UniqKeyMap v -> UniqKeyMap v
 deleteUniq k (UniqKeyMap m x) = UniqKeyMap (M.delete k m) x
 updateUniq :: Int -> (v -> v) -> UniqKeyMap v -> UniqKeyMap v
 updateUniq k f (UniqKeyMap m x) = UniqKeyMap (M.adjust f k m) x
 elemsUniq :: UniqKeyMap v -> [v]
 elemsUniq (UniqKeyMap m _) = M.elems m
 emptyUniqKeyMap :: UniqKeyMap v
 emptyUniqKeyMap = UniqKeyMap mempty 0
--- a/octopod-frontend/src/Page/Popup/NewDeployment.hs
+++ b/octopod-frontend/src/Page/Popup/NewDeployment.hs
@ -1,23 +1,18 @@
-{-|
+-- |
-Module      : Page.Popup.NewDeployment
+--Module      : Page.Popup.NewDeployment
-Description : New deployment sidebar.
+--Description : New deployment sidebar.
-
+--
-This module contains the definition of \"new deployment\" sidebar.
+--This module contains the definition of \"new deployment\" sidebar.
 -}
 module Page.Popup.NewDeployment (newDeploymentPopup) where
 import Control.Lens (preview, _1, _2)
 import Control.Monad
 import           Data.Coerce
 import Data.Functor
 import Data.Generics.Sum
 import           Data.Map as M
 import Data.Monoid
 import Data.Text as T (Text, intercalate)
 import           Prelude as P
 import Reflex.Dom as R
 import Prelude as P
 import Common.Types
 import Common.Validation (isNameValid)
@ -26,38 +21,44 @@ import           Frontend.Utils
 import Servant.Reflex
 import Servant.Reflex.Extra
 -- | The root function for \"new deployment\" sidebar.
-newDeploymentPopup
+newDeploymentPopup ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t ()     -- ^ \"Show\" event.
+  -- | \"Show\" event.
-  -> Event t ()     -- ^ \"Close\" event.
+  Event t () ->
-  -> m ()
+  -- | \"Close\" event.
-newDeploymentPopup showEv hideEv = void $ sidebar showEv hideEv $ const $ mdo
+  Event t () ->
  m ()
 newDeploymentPopup showEv hideEv = void $
  sidebar showEv hideEv $
    const $ mdo
      divClass "popup__body" $ mdo
        (closeEv', saveEv) <- newDeploymentPopupHeader enabledDyn
        (deploymentDyn, validDyn) <- newDeploymentPopupBody respEv
        respEv <- createEndpoint (Right <$> deploymentDyn) saveEv
-    sentDyn <- holdDyn False $ leftmost
+        sentDyn <-
          holdDyn False $
            leftmost
              [ True <$ saveEv
-      , False <$ respEv ]
+              , False <$ respEv
-    let
+              ]
-      successEv =
+        let successEv =
              fmapMaybe (preview (_Ctor @"Success") <=< commandResponse) respEv
-      closeEv = leftmost [ closeEv', successEv ]
+            closeEv = leftmost [closeEv', successEv]
            enabledDyn = zipDynWith (&&) (not <$> sentDyn) validDyn
        pure (never, closeEv)
 -- | The header of sidebar contains control buttons: \"Save\" and \"Close\".
-newDeploymentPopupHeader
+newDeploymentPopupHeader ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Dynamic t Bool
+  Dynamic t Bool ->
-  -> m (Event t (), Event t ())
+  m (Event t (), Event t ())
 newDeploymentPopupHeader enabledDyn =
  divClass "popup__head" $ do
    closeEv <- buttonClass "popup__close" "Close popup"
    elClass "h2" "popup__project" $ text "Create new deployment"
-    saveEv <- divClass "popup__operations" $
+    saveEv <-
      divClass "popup__operations" $
        buttonClassEnabled "popup__action button button--save" "Save" enabledDyn
    divClass "popup__menu drop drop--actions" blank
    pure (closeEv, saveEv)
@ -65,93 +66,58 @@ newDeploymentPopupHeader enabledDyn =
 -- | The body of the sidebar contains the creation form. It contains: a name field,
 -- a tag field and overrides fields. The name field is validated with the regexp:
 -- @^[a-z][a-z0-9\\-]{1,16}$@.
-newDeploymentPopupBody
+newDeploymentPopupBody ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t (ReqResult tag CommandResponse)
+  -- | Request failure event.
-  -- ^ Request failure event.
+  Event t (ReqResult tag CommandResponse) ->
-  -> m (Dynamic t Deployment, Dynamic t Bool)
+  -- | Returns new deployment and validation states.
-  -- ^ Returns new deployment and validation states.
+  m (Dynamic t Deployment, Dynamic t Bool)
 newDeploymentPopupBody errEv = divClass "popup__content" $
  divClass "deployment" $ mdo
-    let
+    let commandResponseEv = fmapMaybe commandResponse errEv
      commandResponseEv = fmapMaybe commandResponse errEv
        appErrEv = R.difference (fmapMaybe reqErrorBody errEv) commandResponseEv
        nameErrEv = getNameError commandResponseEv nameDyn
        tagErrEv = getTagError commandResponseEv tagDyn
    errorHeader appErrEv
    (nameDyn, nOkDyn) <- octopodTextInput "tag" "Name" "Name" Nothing nameErrEv
    (tagDyn, tOkDyn) <- octopodTextInput "tag" "Tag" "Tag" Nothing tagErrEv
-    appVarsDyn <- envVarsInput "App overrides"
+    appVarsDyn <- envVarsInput "App overrides" mempty
-    deploymentVarsDyn <- envVarsInput "Deployment overrides"
+    deploymentVarsDyn <- envVarsInput "Deployment overrides" mempty
    validDyn <- holdDyn False $ updated $ zipDynWith (&&) nOkDyn tOkDyn
-    pure $ (Deployment
+    pure
      ( Deployment
          <$> (DeploymentName <$> nameDyn)
          <*> (DeploymentTag <$> tagDyn)
-      <*> (coerce <$> appVarsDyn)
+          <*> appVarsDyn
-      <*> (coerce <$> deploymentVarsDyn), validDyn)
+          <*> deploymentVarsDyn
      , validDyn
      )
  where
-    getNameError crEv nameDyn = let
+    getNameError crEv nameDyn =
-      nameErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _1 )) crEv
+      let nameErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _1)) crEv
          isNameValidDyn = isNameValid . DeploymentName <$> nameDyn
-      badNameText = "Deployment name length should be longer than 2 characters \
+          badNameText =
            "Deployment name length should be longer than 2 characters \
            \and under 17 characters and begin with a letter."
          badNameEv = badNameText <$ (ffilter not $ updated isNameValidDyn)
          nameErrEv = ffilter (/= "") $ T.intercalate ". " <$> nameErrEv'
       in leftmost [nameErrEv, badNameEv]
-    getTagError crEv tagDyn = let
+    getTagError crEv tagDyn =
-      tagErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _2 )) crEv
+      let tagErrEv' = fmapMaybe (preview (_Ctor @"ValidationError" . _2)) crEv
          tagErrEv = ffilter (/= "") $ T.intercalate ". " <$> tagErrEv'
          badTagText = "Tag should not be empty"
          badNameEv = badTagText <$ (ffilter (== "") $ updated tagDyn)
       in leftmost [tagErrEv, badNameEv]
 -- | The widget used to display errors.
-errorHeader
+errorHeader ::
-  :: MonadWidget t m
+  MonadWidget t m =>
-  => Event t Text -- ^ Message text.
+  -- | Message text.
-  -> m ()
+  Event t Text ->
  m ()
 errorHeader appErrEv = do
-  widgetHold_ blank $ appErrEv <&> \appErr -> do
+  widgetHold_ blank $
    appErrEv <&> \appErr -> do
      divClass "deployment__output notification notification--danger" $ do
        el "b" $ text "App error: "
        text appErr
 -- | Widget with override fields. This widget supports adding and
 -- a removing key-value pairs.
 envVarsInput
  :: MonadWidget t m
  => Text -- ^ Widget header.
  -> m (Dynamic t [Override])
 envVarsInput headerText = do
  elClass "section" "deployment__section" $ do
    elClass "h3" "deployment__sub-heading" $ text headerText
    elClass "div" "deployment__widget" $
      elClass "div" "overrides" $ mdo
        let
          emptyVar = Override "" "" Public
          addEv = clickEv $> Endo (\envs -> P.length envs =: emptyVar <> envs)
        envsDyn <- foldDyn appEndo mempty $ leftmost [ addEv, updEv ]
        (_, updEv)  <- runEventWriterT $ listWithKey envsDyn envVarInput
        let addDisabledDyn = all ( (/= "") . overrideKey ) . elems <$> envsDyn
        clickEv <- buttonClassEnabled'
          "overrides__add dash dash--add" "Add an override" addDisabledDyn
          "dash--disabled"
        pure $ elems <$> envsDyn
 -- | Widget for a key-value pair. It returns an event carrying an update
 -- of overrides list via 'EventWriter'.
 envVarInput
  :: (EventWriter t (Endo (Map Int Override)) m, MonadWidget t m)
  => Int                -- ^ Index of variable in overrides list.
  -> Dynamic t Override -- ^ Current variable key and value.
  -> m ()
 envVarInput ix _ = do
  divClass "overrides__item" $ do
    (keyDyn, _) <- octopodTextInput' "overrides__key" "key" Nothing never
    (valDyn, _) <- octopodTextInput' "overrides__value" "value" Nothing never
    closeEv <- buttonClass "overrides__delete spot spot--cancel" "Delete"
    let
      envEv = updated $ zipDynWith (\k v -> Override k v Public) keyDyn valDyn
      deleteEv = Endo (M.delete ix) <$ closeEv
      updEv = Endo . flip update ix . const . Just <$> envEv
    tellEvent $ leftmost [deleteEv, updEv]