94af996 · typeable/octopod

git.iko.soy/typeable/octopod

add 'info' command

commit94af996717ddb4bb62a85edc24e56b1076df73b0 authorAndrei Orlov <aaorlov1@gmail.com> dateSat 29 Feb 2020, 17:06 (7 years ago) parent6539fe9

7 files changed+130−19

compare with master

unifiedsplit

default.nix+5−5 dm.cabal+6 src/API/Lib.hs+5−7 src/API/Types/Deployment.hs+14 src/API/Types/DeploymentInfo.hs+26 src/DMC/Lib.hs+45−5 src/DMS/Lib.hs+29−2

default.nix+5−5

@@ -1,5 +1,5 @@

1−{ mkDerivation, aeson, base, bytestring, directory, fast-logger

2−, http-client, mtl, network-uri, optparse-generic

1+{ mkDerivation, aeson, base, bytestring, chronos, directory

2+, fast-logger, http-client, mtl, network-uri, optparse-generic

33, postgresql-simple, resource-pool, servant, servant-client

44, servant-server, stdenv, temporary, text, transformers

55, typed-process, warp

@@ -11,19 +11,19 @@ mkDerivation {

1111 isLibrary = true;

1212 isExecutable = true;

1313 libraryHaskellDepends = [

14− aeson base bytestring directory fast-logger http-client mtl

14+ aeson base bytestring chronos directory fast-logger http-client mtl

1515 network-uri optparse-generic postgresql-simple resource-pool

1616 servant servant-client servant-server temporary text transformers

1717 typed-process warp

1818 ];

1919 executableHaskellDepends = [

20− aeson base bytestring directory fast-logger http-client mtl

20+ aeson base bytestring chronos directory fast-logger http-client mtl

2121 network-uri optparse-generic postgresql-simple resource-pool

2222 servant servant-client servant-server temporary text transformers

2323 typed-process warp

2424 ];

2525 testHaskellDepends = [

26− aeson base bytestring directory fast-logger http-client mtl

26+ aeson base bytestring chronos directory fast-logger http-client mtl

2727 network-uri optparse-generic postgresql-simple resource-pool

2828 servant servant-client servant-server temporary text transformers

2929 typed-process warp

dm.cabal+6

@@ -28,6 +28,8 @@ source-repository head

2828library

2929 exposed-modules:

3030 API.Lib

31+ API.Types.Deployment

32+ API.Types.DeploymentInfo

3133 DMC.Lib

3234 DMS.Helm

3335 DMS.Lib

@@ -40,6 +42,7 @@ library

4042 aeson

4143 , base >=4.7 && <5

4244 , bytestring

45+ , chronos

4346 , directory

4447 , fast-logger

4548 , http-client

@@ -69,6 +72,7 @@ executable dmc-exe

6972 aeson

7073 , base >=4.7 && <5

7174 , bytestring

75+ , chronos

7276 , directory

7377 , dm

7478 , fast-logger

@@ -99,6 +103,7 @@ executable dms-exe

99103 aeson

100104 , base >=4.7 && <5

101105 , bytestring

106+ , chronos

102107 , directory

103108 , dm

104109 , fast-logger

@@ -130,6 +135,7 @@ test-suite dm-test

130135 aeson

131136 , base >=4.7 && <5

132137 , bytestring

138+ , chronos

133139 , directory

134140 , dm

135141 , fast-logger

src/API/Lib.hs+5−7

@@ -1,10 +1,11 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE TypeOperators #-}

3−{-# LANGUAGE DeriveGeneric #-}

54module API.Lib

65 ( Deployment (..)

76 , DeploymentAPI

7+ , DeploymentInfo (..)

8+ , DeploymentLog (..)

89 ) where

910

1011import Data.Aeson

@@ -12,12 +13,8 @@ import Data.Text (Text)

1213import Options.Generic

1314import Servant.API

1415

15−data Deployment

16− = Deployment { name :: Text, tag :: Text, envs :: [Text] }

17− deriving (Generic, Show)

18−

19−instance ToJSON Deployment

20−instance FromJSON Deployment

16+import API.Types.Deployment

17+import API.Types.DeploymentInfo

2118

2219type DeploymentAPI = "api" :> "v1" :>

2320 ( "deployments" :>

@@ -27,6 +24,7 @@ type DeploymentAPI = "api" :> "v1" :>

2724 :<|> Capture "name" Text :> ReqBody '[JSON] Deployment :> PatchNoContent '[PlainText] Text

2825 :<|> Capture "name" Text :> DeleteNoContent '[PlainText] Text

2926 :<|> Capture "name" Text :> ReqBody '[JSON] Deployment :> PutNoContent '[PlainText] Text

27+ :<|> Capture "name" Text :> "info" :> Get '[JSON] [DeploymentInfo]

3028 )

3129 :<|> "ping" :> GetNoContent '[PlainText] Text

3230 )

src/API/Types/Deployment.hsnew file+14

@@ -0,0 +1,14 @@

1+{-# LANGUAGE DeriveGeneric #-}

3+module API.Types.Deployment (Deployment (..)) where

5+import Data.Aeson

6+import Data.Text (Text)

7+import Options.Generic

9+data Deployment

10+ = Deployment { name :: Text, tag :: Text, envs :: [Text] }

11+ deriving (Generic, Show)

12+

13+instance FromJSON Deployment

14+instance ToJSON Deployment

src/API/Types/DeploymentInfo.hsnew file+26

@@ -0,0 +1,26 @@

1+{-# LANGUAGE DeriveGeneric #-}

3+module API.Types.DeploymentInfo

4+ ( DeploymentInfo (..)

5+ , DeploymentLog (..)

6+ ) where

8+import Data.Aeson

9+import Data.Text (Text)

10+import Options.Generic

11+

12+import API.Types.Deployment

13+

14+data DeploymentLog

15+ = DeploymentLog { action :: Text, deploymentTag :: Text, deploymentEnvs :: [Text], exitCode :: Int, createdAt :: Int }

16+ deriving (Generic, Show)

17+

18+instance FromJSON DeploymentLog

19+instance ToJSON DeploymentLog

20+

21+data DeploymentInfo

22+ = DeploymentInfo { deployment :: Deployment, logs :: [DeploymentLog] }

23+ deriving (Generic, Show)

24+

25+instance FromJSON DeploymentInfo

26+instance ToJSON DeploymentInfo

src/DMC/Lib.hs+45−5

@@ -6,12 +6,13 @@ module DMC.Lib

66 ( runDMC

77 ) where

9−import Prelude hiding (unlines)

9+import Prelude hiding (unlines, unwords)

1010

11+import Chronos

1112import Control.Monad

1213import Data.Maybe (fromMaybe)

1314import Data.Proxy

14−import Data.Text (pack, unlines, unpack)

15+import Data.Text (pack, unlines, unpack, unwords)

1516import Options.Generic

1617import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, newManager, responseTimeoutMicro)

1718import Network.URI

@@ -22,7 +23,18 @@ import System.IO

2223import System.IO.Temp

2324import System.Process.Typed

2425

25−import API.Lib (Deployment (Deployment), DeploymentAPI)

26+import API.Lib ( Deployment (Deployment)

27+ , DeploymentAPI

28+ , DeploymentInfo (DeploymentInfo)

29+ , deployment

30+ , logs

31+ , DeploymentLog (DeploymentLog)

32+ , action

33+ , deploymentTag

34+ , deploymentEnvs

35+ , exitCode

36+ , createdAt

37+ )

2638

2739data Args

2840 = Create { name :: Text, tag :: Text, envs :: [Text] }

@@ -30,6 +42,7 @@ data Args

3042 | Edit { name :: Text }

3143 | Destroy { name :: Text }

3244 | Update { name :: Text, tag :: Text }

45+ | Info { name :: Text }

3346 deriving (Generic, Show)

3447

3548instance ParseRecord Args where

@@ -72,7 +85,7 @@ handleCommand clientEnv Edit {name} = do

7285 Just ed -> do

7386 res <- flip runClientM clientEnv $ get name

7487 case res of

75− Right ((Deployment _ t e) : _) -> editEnvs ed e >>= sendUpdate t

88+ Right (Deployment _ t e : _) -> editEnvs ed e >>= sendUpdate t

7689 Right [] -> print $ "deployment " ++ unpack name ++ " not found"

7790 Left err -> print $ "request failed, reason: " ++ show err

7891 Nothing -> print "environment variable $EDITOR not found"

@@ -92,10 +105,17 @@ handleCommand clientEnv Update {name, tag}

92105 = handleResponse =<< runClientM (update name $ Deployment name tag envs) clientEnv

93106 where envs = ["UNUSED_KEY=UNUSED_VALUE"]

94107

108+handleCommand clientEnv Info {name} = do

109+ res <- runClientM (info name) clientEnv

110+ case res of

111+ Right (i : _) -> printInfo i

112+ Right [] -> print $ "deployment " ++ unpack name ++ " not found"

113+ Left err -> print $ "request failed, reason: " ++ show err

114+

95115deploymentAPI :: Proxy DeploymentAPI

96116deploymentAPI = Proxy

97117

99119

100120list :: ClientM [Text]

101121

@@ -109,7 +129,27 @@ destroy :: Text -> ClientM Text

109129

110130update :: Text -> Deployment -> ClientM Text

111131

132+info :: Text -> ClientM [DeploymentInfo]

133+

112134ping :: ClientM Text

113135

114136handleResponse (Right result) = putStrLn (unpack result) >> putStrLn "done"

115137handleResponse (Left err) = putStrLn $ "command failed, reason: " ++ show err

138+

139+printInfo DeploymentInfo {deployment, logs} = do

140+ let Deployment n t e = deployment

141+ putStrLn "Current settings:"

142+ putStrLn $ "tag: " ++ unpack t

143+ putStrLn $ "envs: " ++ unpack (unwords e)

144+ putStrLn $ "URL: " ++ unpack n ++ ".kube.thebestagent.pro"

145+ putStrLn ""

146+ putStrLn "Last logs:"

147+ mapM_ ppDeploymentLog $ reverse logs

148+

149+ppDeploymentLog DeploymentLog {action, deploymentTag, deploymentEnvs, exitCode, createdAt}

150+ = putStrLn . unpack . unwords $ [ encode_YmdHMS SubsecondPrecisionAuto w3c (timeToDatetime . Time . fromIntegral $ createdAt * 10^9)

151+ , action

152+ , deploymentTag

153+ , unwords deploymentEnvs

154+ , pack $ show exitCode

155+ ]

src/DMS/Lib.hs+29−2

@@ -25,7 +25,7 @@ import System.Exit

2525import System.Log.FastLogger

2626import System.Process.Typed

2727

28−import API.Lib (Deployment (Deployment), DeploymentAPI, name, tag, envs)

28+import API.Lib

2929import DMS.Helm

3030

3131data Args

@@ -74,7 +74,7 @@ deploymentAPI :: Proxy DeploymentAPI

7474deploymentAPI = Proxy

7575

7676server :: ServerT DeploymentAPI AppM

7878

7979list :: AppM [Text]

8080list = do

@@ -234,6 +234,33 @@ update n d@Deployment { tag = t } = do

234234

235235 appArgs Deployment { name = n, tag = t, envs = e } = updateAppArgs (unpack n) (unpack t) (fmap unpack e)

236236

237+info :: Text -> AppM [DeploymentInfo]

238+info n = do

239+ State{pool = p, logger = l} <- ask

240+ liftIO $ do

241+ d <- getDeployment p

242+ dl <- getDeploymentLogs p

243+ let di = DeploymentInfo { deployment = head d, logs = dl }

244+ logInfo l $ "get deployment info: " <> (pack . show $ di)

245+ return [di]

246+

247+ where

248+ getDeployment :: PgPool -> IO [Deployment]

249+ getDeployment p = fmap (fmap (\(n, t, e) -> Deployment n t $ lines e)) $ withResource p $ \conn ->

250+ query conn "SELECT name, tag, envs FROM deployments WHERE name = ?" (Only n)

251+

252+ getDeploymentLogs :: PgPool -> IO [DeploymentLog]

253+ getDeploymentLogs p = fmap (fmap (\(a, t, e, c, ts) -> DeploymentLog a t (lines e) c ts)) $ withResource p $ \conn ->

254+ query conn q (Only n)

255+

256+ where q = "SELECT action::text, tag, envs, exit_code, extract(epoch from created_at)::int \

257+ \FROM deployment_logs \

258+ \WHERE deployment_id in (\

259+ \SELECT id FROM deployments WHERE name = ?\

260+ \) \

261+ \ORDER BY created_at DESC \

262+ \LIMIT 20"

263+

237264ping :: AppM Text

238265ping = do

239266 State{pool = p} <- ask