From 041c1ea4e338ab9d2158155f645a729e549db60a Mon Sep 17 00:00:00 2001 From: iko Date: Wed, 8 Dec 2021 18:53:17 +0300 Subject: [PATCH] Added ability to delete deployments, made cli output prettier (#157) * Added ability to delete deployment, made cli output prettier * stop failing script --- dev/default.nix | 4 +- octo-cli/src/Octopod/CLI.hs | 60 ++++++++++++++++++++------- octo-cli/src/Octopod/CLI/Args.hs | 31 +++++++------- octopod-api/src/Octopod/PowerAPI.hs | 5 +++ octopod-backend/src/Octopod/Server.hs | 17 ++++++++ octopod-common/src/Common/Types.hs | 9 ---- 6 files changed, 85 insertions(+), 41 deletions(-) diff --git a/dev/default.nix b/dev/default.nix index fcbb4f7..7a62a48 100644 --- a/dev/default.nix +++ b/dev/default.nix @@ -115,7 +115,7 @@ in sleep 4 - for i in {1..50} + for i in {1..10} do echo "key$i,value" done @@ -128,7 +128,7 @@ in sleep 4 - for i in {1..50} + for i in {1..10} do echo "key$i" done diff --git a/octo-cli/src/Octopod/CLI.hs b/octo-cli/src/Octopod/CLI.hs index 93c4d41..5883d12 100644 --- a/octo-cli/src/Octopod/CLI.hs +++ b/octo-cli/src/Octopod/CLI.hs @@ -82,6 +82,8 @@ runOcto = do Restore tName -> handleRestore auth . coerce $ tName GetActionLogs aId l -> handleGetActionInfo auth aId l + Delete tName -> + handleDelete auth . coerce $ tName -- | Returns BaseUrl from 'OCTOPOD_URL' environment variable -- or exit with exit_code=1. @@ -181,6 +183,13 @@ handleCleanup auth dName = do liftIO $ handleResponse (const $ pure ()) =<< runClientM (cleanupH auth dName) clientEnv +-- | Handles the 'delete' subcommand. +handleDelete :: AuthContext AuthHeaderAuth -> DeploymentName -> ReaderT ClientEnv IO () +handleDelete auth dName = do + clientEnv <- ask + liftIO $ + handleResponse (const $ pure ()) =<< runClientM (deleteH auth dName) clientEnv + -- | Handles the 'restore' subcommand. handleRestore :: AuthContext AuthHeaderAuth -> DeploymentName -> ReaderT ClientEnv IO () handleRestore auth dName = do @@ -214,6 +223,7 @@ _statusH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CurrentDeplo cleanupH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse restoreH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse getActionInfoH :: AuthContext AuthHeaderAuth -> ActionId -> ClientM ActionInfo +deleteH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse ( listH :<|> createH :<|> archiveH @@ -223,6 +233,7 @@ getActionInfoH :: AuthContext AuthHeaderAuth -> ActionId -> ClientM ActionInfo :<|> _statusH :<|> cleanupH :<|> restoreH + :<|> deleteH ) :<|> getActionInfoH = pushArrowIntoServantAlt $ client (Proxy @PowerAPI) @@ -264,13 +275,13 @@ decodeError body = printInfo :: DeploymentInfo -> IO () printInfo (DeploymentInfo (Deployment _ dAppOvs dStOvs) (DeploymentMetadata dMeta) dLogs) = do T.putStrLn "Current settings:" - T.putStrLn $ - "application config: " - <> formatOverrides dAppOvs - T.putStrLn $ - "deployment config: " - <> formatOverrides dStOvs - T.putStrLn $ "metadata: " + T.putStrLn "Application config:" + putStrLn $ unlines $ formatOverrides False dAppOvs + T.putStrLn "" + T.putStrLn "Deployment config: " + putStrLn $ unlines $ formatOverrides False dStOvs + T.putStrLn "" + T.putStrLn $ "Metadata: " forM_ dMeta $ \m -> T.putStrLn $ " " <> m ^. #name <> ": " <> m ^. #link @@ -282,15 +293,14 @@ ppDeploymentLogs :: [DeploymentLog] -> IO () ppDeploymentLogs ds = putStrLn . tableString - [ column expand right noAlign def + [ column expand center noAlign def + , column expand center noAlign def , column expand center noAlign def , column expand center noAlign def , column expand center noAlign def - , column expand left (charAlign '=') def - , column expand left (charAlign '=') def , column expand center noAlign def ] - unicodeBoldHeaderS + unicodeDoubleFrameS ( titlesH [ "Created at" , "Action id" @@ -303,17 +313,35 @@ ppDeploymentLogs ds = $ ppDeploymentLogRow <$> ds -- | Pretty-prints the deployment log. -ppDeploymentLogRow :: DeploymentLog -> RowGroup Text +ppDeploymentLogRow :: DeploymentLog -> RowGroup String ppDeploymentLogRow dLog = colsAllG top [ - [ T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) $ + [ formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) $ dLog ^. field @"createdAt" ] , [dLog ^. field @"actionId" . to unActionId . re _Show . packed] - , [dLog ^. field @"action" . to actionToText] - , dLog ^. field @"deploymentAppOverrides" . to formatOverrides' - , dLog ^. field @"deploymentDepOverrides" . to formatOverrides' + , [dLog ^. field @"action" . to (T.unpack . actionToText)] + , dLog ^. field @"deploymentAppOverrides" . to (stripBorder . formatOverrides True) + , dLog ^. field @"deploymentDepOverrides" . to (stripBorder . formatOverrides True) , [dLog ^. field @"exitCode" . re _Show . packed] ] + +stripBorder :: [String] -> [String] +stripBorder = fmap (init . tail) . init . tail + +formatOverrides :: Bool -> Overrides l -> [String] +formatOverrides splitlines (Overrides m) = + tableLines + [ column expand right noAlign def + , column expand left noAlign def + ] + unicodeS + def + $ showOverride <$> (reverse . OM.assocs) m + where + showOverride (k, v) = + colsAllG top $ [if splitlines then T.chunksOf 15 k else [k], showValue v] + showValue (ValueAdded v) = if splitlines then T.chunksOf 25 v else [v] + showValue ValueDeleted = ["<>"] diff --git a/octo-cli/src/Octopod/CLI/Args.hs b/octo-cli/src/Octopod/CLI/Args.hs index 42021bb..774a870 100644 --- a/octo-cli/src/Octopod/CLI/Args.hs +++ b/octo-cli/src/Octopod/CLI/Args.hs @@ -49,6 +49,9 @@ data Args name :: Text } | GetActionLogs ActionId LogOutput + | Delete + { name :: Text + } deriving stock (Show) data LogOutput = Err | Out | ErrOut @@ -81,13 +84,14 @@ commandArgs = <> command "logs" (info actionLogsArgs (progDesc "get deployment logs of a given action")) + <> command "delete" (info deleteArgs (progDesc "delete the deployment from Octopod. Does no cleanup.")) ) -- | Parses arguments of 'create' subcommand. createArgs :: Parser Args createArgs = Create - <$> strOption (long "name" <> short 'n' <> help "deployment name") + <$> deploymentNameArgument <*> many ( strOption ( long "set-app-config" @@ -110,15 +114,13 @@ listArgs = -- | Parses arguments of 'archive' subcommand. archiveArgs :: Parser Args -archiveArgs = - Archive - <$> strOption (long "name" <> short 'n' <> help "deployment name") +archiveArgs = Archive <$> deploymentNameArgument -- | Parses arguments of 'update' subcommand. updateArgs :: Parser Args updateArgs = Update - <$> strOption (long "name" <> short 'n' <> help "deployment name") + <$> deploymentNameArgument <*> many ( strOption ( long "set-app-config" @@ -150,21 +152,19 @@ updateArgs = -- | Parses arguments of 'info' subcommand. infoArgs :: Parser Args -infoArgs = - Info - <$> strOption (long "name" <> short 'n' <> help "deployment name") +infoArgs = Info <$> deploymentNameArgument -- | Parses arguments of 'cleanup' subcommand. cleanupArgs :: Parser Args -cleanupArgs = - Cleanup - <$> strOption (long "name" <> short 'n' <> help "deployment name") +cleanupArgs = Cleanup <$> deploymentNameArgument + +-- | Parses arguments of 'delete' subcommand. +deleteArgs :: Parser Args +deleteArgs = Delete <$> deploymentNameArgument -- | Parses arguments of 'restore' subcommand. restoreArgs :: Parser Args -restoreArgs = - Restore - <$> strOption (long "name" <> short 'n' <> help "deployment name") +restoreArgs = Restore <$> deploymentNameArgument actionLogsArgs :: Parser Args actionLogsArgs = @@ -178,3 +178,6 @@ actionLogsArgs = <> value ErrOut <> completeWith ["stdout", "stderr", "all"] ) + +deploymentNameArgument :: Parser Text +deploymentNameArgument = strOption (long "name" <> short 'n' <> help "deployment name") diff --git a/octopod-api/src/Octopod/PowerAPI.hs b/octopod-api/src/Octopod/PowerAPI.hs index 746e39e..c5ec117 100644 --- a/octopod-api/src/Octopod/PowerAPI.hs +++ b/octopod-api/src/Octopod/PowerAPI.hs @@ -36,6 +36,9 @@ type StatusEndpoint c = c :> "status" :> Get '[JSON] CurrentDeploymentStatus type CleanupEndpoint c = c :> "cleanup" :> Delete '[JSON] CommandResponse +type DeleteEndpoint c = + c :> "delete" :> Delete '[JSON] CommandResponse + type RestoreEndpoint c = c :> "restore" :> Patch '[JSON] CommandResponse @@ -63,6 +66,8 @@ type DeploymentAPI' c = -- endpoint to clean up resources of an archived deployment :<|> RestoreEndpoint c -- endpoint to restore an archived deployment + :<|> DeleteEndpoint c + -- endpoint to clean up resources of an archived deployment ) :<|> GetActionInfoEndpoint -- endpoint to get action logs diff --git a/octopod-backend/src/Octopod/Server.hs b/octopod-backend/src/Octopod/Server.hs index 4878f87..b4cb9f3 100644 --- a/octopod-backend/src/Octopod/Server.hs +++ b/octopod-backend/src/Octopod/Server.hs @@ -420,6 +420,7 @@ powerServer (Authenticated ()) = :<|> statusH :<|> cleanupH :<|> restoreH + :<|> deleteH ) :<|> getActionInfoH powerServer _ = throwAll err401 @@ -921,6 +922,13 @@ cleanupH dName = do runDeploymentBgWorker Nothing dName (pure ()) $ \() -> cleanupDeployment dName pure Success +-- | Deletes the deployment from the DB. +deleteH :: DeploymentName -> AppM CommandResponse +deleteH dName = do + failIfGracefulShutdownActivated + runDeploymentBgWorker Nothing dName (pure ()) $ \() -> deleteAllDeployment dName + pure Success + -- | Helper to cleanup deployment. cleanupDeployment :: (KatipContext m, MonadBaseControl IO m, MonadReader AppState m, MonadError ServerError m) => @@ -951,6 +959,15 @@ cleanupDeployment dName = do sendReloadEvent handleExitCode ec +deleteAllDeployment :: + (KatipContext m, MonadBaseControl IO m, MonadReader AppState m) => + DeploymentName -> + m () +deleteAllDeployment dName = do + deleteDeploymentLogs dName + deleteDeployment dName + logLocM InfoS $ logStr $ "deployment destroyed, name: " <> unDeploymentName dName + -- | Helper to delete deployment logs. deleteDeploymentLogs :: (KatipContext m, MonadBaseControl IO m, MonadReader AppState m) => diff --git a/octopod-common/src/Common/Types.hs b/octopod-common/src/Common/Types.hs index d4dea64..21a04e8 100644 --- a/octopod-common/src/Common/Types.hs +++ b/octopod-common/src/Common/Types.hs @@ -397,12 +397,3 @@ parseSetOverrides texts = do parseUnsetOverrides :: [Text] -> Overrides l parseUnsetOverrides = Overrides . OM.fromList . fmap (,ValueDeleted) - -formatOverrides :: Overrides l -> Text -formatOverrides = T.unlines . formatOverrides' - -formatOverrides' :: Overrides l -> [Text] -formatOverrides' (Overrides m) = fmap (\(k, v) -> k <> "=" <> showValue v) . OM.assocs $ m - where - showValue (ValueAdded v) = v - showValue ValueDeleted = ""