041c1ea · typeable/octopod

git.iko.soy/typeable/octopod

Added ability to delete deployments, made cli output prettier (#157)

* Added ability to delete deployment, made cli output prettier * stop failing script

commit041c1ea4e338ab9d2158155f645a729e549db60a authoriko <ilyakooo0@gmail.com> dateWed 8 Dec 2021, 18:53 (5 years ago) parentc840c6e

6 files changed+85−41

compare with master

unifiedsplit

dev/default.nix+2−2 octo-cli/src/Octopod/CLI.hs+44−16 octo-cli/src/Octopod/CLI/Args.hs+17−14 octopod-api/src/Octopod/PowerAPI.hs+5 octopod-backend/src/Octopod/Server.hs+17 octopod-common/src/Common/Types.hs−9

dev/default.nix+2−2

@@ -115,7 +115,7 @@ in

115115

116116 sleep 4

117117

118− for i in {1..50}

118+ for i in {1..10}

119119 do

120120 echo "key$i,value"

121121 done

@@ -128,7 +128,7 @@ in

128128

129129 sleep 4

130130

131− for i in {1..50}

131+ for i in {1..10}

132132 do

133133 echo "key$i"

134134 done

octo-cli/src/Octopod/CLI.hs+44−16

@@ -82,6 +82,8 @@ runOcto = do

8282 Restore tName ->

8383 handleRestore auth . coerce $ tName

8484 GetActionLogs aId l -> handleGetActionInfo auth aId l

85+ Delete tName ->

86+ handleDelete auth . coerce $ tName

8587

8688-- | Returns BaseUrl from 'OCTOPOD_URL' environment variable

8789-- or exit with exit_code=1.

@@ -181,6 +183,13 @@ handleCleanup auth dName = do

181183 liftIO $

182184 handleResponse (const $ pure ()) =<< runClientM (cleanupH auth dName) clientEnv

183185

186+-- | Handles the 'delete' subcommand.

187+handleDelete :: AuthContext AuthHeaderAuth -> DeploymentName -> ReaderT ClientEnv IO ()

188+handleDelete auth dName = do

189+ clientEnv <- ask

190+ liftIO $

191+ handleResponse (const $ pure ()) =<< runClientM (deleteH auth dName) clientEnv

192+

184193-- | Handles the 'restore' subcommand.

185194handleRestore :: AuthContext AuthHeaderAuth -> DeploymentName -> ReaderT ClientEnv IO ()

186195handleRestore auth dName = do

@@ -214,6 +223,7 @@ _statusH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CurrentDeplo

214223cleanupH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse

215224restoreH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse

216225getActionInfoH :: AuthContext AuthHeaderAuth -> ActionId -> ClientM ActionInfo

226+deleteH :: AuthContext AuthHeaderAuth -> DeploymentName -> ClientM CommandResponse

217227( listH

218228 :<|> createH

219229 :<|> archiveH

@@ -223,6 +233,7 @@ getActionInfoH :: AuthContext AuthHeaderAuth -> ActionId -> ClientM ActionInfo

223233 :<|> _statusH

224234 :<|> cleanupH

225235 :<|> restoreH

236+ :<|> deleteH

226237 )

227238 :<|> getActionInfoH = pushArrowIntoServantAlt $ client (Proxy @PowerAPI)

228239

@@ -264,13 +275,13 @@ decodeError body =

264275printInfo :: DeploymentInfo -> IO ()

265276printInfo (DeploymentInfo (Deployment _ dAppOvs dStOvs) (DeploymentMetadata dMeta) dLogs) = do

266277 T.putStrLn "Current settings:"

267− T.putStrLn $

268− "application config: "

269− <> formatOverrides dAppOvs

270− T.putStrLn $

271− "deployment config: "

272− <> formatOverrides dStOvs

273− T.putStrLn $ "metadata: "

278+ T.putStrLn "Application config:"

279+ putStrLn $ unlines $ formatOverrides False dAppOvs

280+ T.putStrLn ""

281+ T.putStrLn "Deployment config: "

282+ putStrLn $ unlines $ formatOverrides False dStOvs

283+ T.putStrLn ""

284+ T.putStrLn $ "Metadata: "

274285 forM_ dMeta $ \m ->

275286 T.putStrLn $

276287 " " <> m ^. #name <> ": " <> m ^. #link

@@ -282,15 +293,14 @@ ppDeploymentLogs :: [DeploymentLog] -> IO ()

282293ppDeploymentLogs ds =

283294 putStrLn

284295 . tableString

285− [ column expand right noAlign def

296+ [ column expand center noAlign def

297+ , column expand center noAlign def

286298 , column expand center noAlign def

287299 , column expand center noAlign def

288300 , column expand center noAlign def

289− , column expand left (charAlign '=') def

290− , column expand left (charAlign '=') def

291301 , column expand center noAlign def

292302 ]

293− unicodeBoldHeaderS

303+ unicodeDoubleFrameS

294304 ( titlesH

295305 [ "Created at"

296306 , "Action id"

@@ -303,17 +313,35 @@ ppDeploymentLogs ds =

303313 $ ppDeploymentLogRow <$> ds

304314

305315-- | Pretty-prints the deployment log.

306−ppDeploymentLogRow :: DeploymentLog -> RowGroup Text

316+ppDeploymentLogRow :: DeploymentLog -> RowGroup String

307317ppDeploymentLogRow dLog =

308318 colsAllG

309319 top

310320 [

311− [ T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) $

321+ [ formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) $

312322 dLog ^. field @"createdAt"

313323 ]

314324 , [dLog ^. field @"actionId" . to unActionId . re _Show . packed]

315− , [dLog ^. field @"action" . to actionToText]

316− , dLog ^. field @"deploymentAppOverrides" . to formatOverrides'

317− , dLog ^. field @"deploymentDepOverrides" . to formatOverrides'

325+ , [dLog ^. field @"action" . to (T.unpack . actionToText)]

326+ , dLog ^. field @"deploymentAppOverrides" . to (stripBorder . formatOverrides True)

327+ , dLog ^. field @"deploymentDepOverrides" . to (stripBorder . formatOverrides True)

318328 , [dLog ^. field @"exitCode" . re _Show . packed]

319329 ]

330+

331+stripBorder :: [String] -> [String]

332+stripBorder = fmap (init . tail) . init . tail

333+

334+formatOverrides :: Bool -> Overrides l -> [String]

335+formatOverrides splitlines (Overrides m) =

336+ tableLines

337+ [ column expand right noAlign def

338+ , column expand left noAlign def

339+ ]

340+ unicodeS

341+ def

342+ $ showOverride <$> (reverse . OM.assocs) m

343+ where

344+ showOverride (k, v) =

345+ colsAllG top $ [if splitlines then T.chunksOf 15 k else [k], showValue v]

346+ showValue (ValueAdded v) = if splitlines then T.chunksOf 25 v else [v]

347+ showValue ValueDeleted = ["<<REMOVED>>"]

octo-cli/src/Octopod/CLI/Args.hs+17−14

@@ -49,6 +49,9 @@ data Args

4949 name :: Text

5050 }

5151 | GetActionLogs ActionId LogOutput

52+ | Delete

53+ { name :: Text

54+ }

5255 deriving stock (Show)

5356

5457data LogOutput = Err | Out | ErrOut

@@ -81,13 +84,14 @@ commandArgs =

8184 <> command

8285 "logs"

8386 (info actionLogsArgs (progDesc "get deployment logs of a given action"))

87+ <> command "delete" (info deleteArgs (progDesc "delete the deployment from Octopod. Does no cleanup."))

8488 )

8589

8690-- | Parses arguments of 'create' subcommand.

8791createArgs :: Parser Args

8892createArgs =

8993 Create

90− <$> strOption (long "name" <> short 'n' <> help "deployment name")

94+ <$> deploymentNameArgument

9195 <*> many

9296 ( strOption

9397 ( long "set-app-config"

@@ -110,15 +114,13 @@ listArgs =

110114

111115-- | Parses arguments of 'archive' subcommand.

112116archiveArgs :: Parser Args

113−archiveArgs =

114− Archive

115− <$> strOption (long "name" <> short 'n' <> help "deployment name")

117+archiveArgs = Archive <$> deploymentNameArgument

116118

117119-- | Parses arguments of 'update' subcommand.

118120updateArgs :: Parser Args

119121updateArgs =

120122 Update

121− <$> strOption (long "name" <> short 'n' <> help "deployment name")

123+ <$> deploymentNameArgument

122124 <*> many

123125 ( strOption

124126 ( long "set-app-config"

@@ -150,21 +152,19 @@ updateArgs =

150152

151153-- | Parses arguments of 'info' subcommand.

152154infoArgs :: Parser Args

153−infoArgs =

154− Info

155− <$> strOption (long "name" <> short 'n' <> help "deployment name")

155+infoArgs = Info <$> deploymentNameArgument

156156

157157-- | Parses arguments of 'cleanup' subcommand.

158158cleanupArgs :: Parser Args

159−cleanupArgs =

160− Cleanup

161− <$> strOption (long "name" <> short 'n' <> help "deployment name")

159+cleanupArgs = Cleanup <$> deploymentNameArgument

160+

161+-- | Parses arguments of 'delete' subcommand.

162+deleteArgs :: Parser Args

163+deleteArgs = Delete <$> deploymentNameArgument

162164

163165-- | Parses arguments of 'restore' subcommand.

164166restoreArgs :: Parser Args

165−restoreArgs =

166− Restore

167− <$> strOption (long "name" <> short 'n' <> help "deployment name")

167+restoreArgs = Restore <$> deploymentNameArgument

168168

169169actionLogsArgs :: Parser Args

170170actionLogsArgs =

@@ -178,3 +178,6 @@ actionLogsArgs =

178178 <> value ErrOut

179179 <> completeWith ["stdout", "stderr", "all"]

180180 )

181+

182+deploymentNameArgument :: Parser Text

183+deploymentNameArgument = strOption (long "name" <> short 'n' <> help "deployment name")

octopod-api/src/Octopod/PowerAPI.hs+5

@@ -36,6 +36,9 @@ type StatusEndpoint c = c :> "status" :> Get '[JSON] CurrentDeploymentStatus

3636type CleanupEndpoint c =

3737 c :> "cleanup" :> Delete '[JSON] CommandResponse

3838

39+type DeleteEndpoint c =

40+ c :> "delete" :> Delete '[JSON] CommandResponse

41+

3942type RestoreEndpoint c =

4043 c :> "restore" :> Patch '[JSON] CommandResponse

4144

@@ -63,6 +66,8 @@ type DeploymentAPI' c =

6366 -- endpoint to clean up resources of an archived deployment

6467 :<|> RestoreEndpoint c

6568 -- endpoint to restore an archived deployment

69+ :<|> DeleteEndpoint c

70+ -- endpoint to clean up resources of an archived deployment

6671 )

6772 :<|> GetActionInfoEndpoint

6873 -- endpoint to get action logs

octopod-backend/src/Octopod/Server.hs+17

@@ -420,6 +420,7 @@ powerServer (Authenticated ()) =

420420 :<|> statusH

421421 :<|> cleanupH

422422 :<|> restoreH

423+ :<|> deleteH

423424 )

424425 :<|> getActionInfoH

425426powerServer _ = throwAll err401

@@ -921,6 +922,13 @@ cleanupH dName = do

921922 runDeploymentBgWorker Nothing dName (pure ()) $ \() -> cleanupDeployment dName

922923 pure Success

923924

925+-- | Deletes the deployment from the DB.

926+deleteH :: DeploymentName -> AppM CommandResponse

927+deleteH dName = do

928+ failIfGracefulShutdownActivated

929+ runDeploymentBgWorker Nothing dName (pure ()) $ \() -> deleteAllDeployment dName

930+ pure Success

931+

924932-- | Helper to cleanup deployment.

925933cleanupDeployment ::

926934 (KatipContext m, MonadBaseControl IO m, MonadReader AppState m, MonadError ServerError m) =>

@@ -951,6 +959,15 @@ cleanupDeployment dName = do

951959 sendReloadEvent

952960 handleExitCode ec

953961

962+deleteAllDeployment ::

963+ (KatipContext m, MonadBaseControl IO m, MonadReader AppState m) =>

964+ DeploymentName ->

965+ m ()

966+deleteAllDeployment dName = do

967+ deleteDeploymentLogs dName

968+ deleteDeployment dName

969+ logLocM InfoS $ logStr $ "deployment destroyed, name: " <> unDeploymentName dName

970+

954971-- | Helper to delete deployment logs.

955972deleteDeploymentLogs ::

956973 (KatipContext m, MonadBaseControl IO m, MonadReader AppState m) =>

octopod-common/src/Common/Types.hs−9

@@ -397,12 +397,3 @@ parseSetOverrides texts = do

397397

398398parseUnsetOverrides :: [Text] -> Overrides l

399399parseUnsetOverrides = Overrides . OM.fromList . fmap (,ValueDeleted)

400−

401−formatOverrides :: Overrides l -> Text

402−formatOverrides = T.unlines . formatOverrides'

403−

404−formatOverrides' :: Overrides l -> [Text]

405−formatOverrides' (Overrides m) = fmap (\(k, v) -> k <> "=" <> showValue v) . OM.assocs $ m

406− where

407− showValue (ValueAdded v) = v

408− showValue ValueDeleted = "<removed>"