fb42663 · typeable/octopod

git.iko.soy/typeable/octopod

add handling of environment variables to 'update' command

commitfb426636bc9a21a59206be9c84b58fe65ede06ac authorAndrei Orlov <aaorlov1@gmail.com> dateFri 5 Jun 2020, 17:25 (6 years ago) parent95f660c

4 files changed+17−8

compare with master

unifiedsplit

src/API.hs+1−1 src/DMC.hs+3−2 src/DMS.hs+6−5 src/Types.hs+7

src/API.hs+1−1

@@ -15,7 +15,7 @@ type EditEndpoint c =

1515 c :> ReqBody '[JSON] EnvPairs :> PatchNoContent '[PlainText] NoContent

1616type DestroyEndpoint c = c :> DeleteNoContent '[PlainText] NoContent

1717type UpdateEndpoint c =

18− c :> Capture "tag" DeploymentTag :> PutNoContent '[PlainText] NoContent

18+ c :> ReqBody '[JSON] DeploymentUpdate :> PutNoContent '[PlainText] NoContent

1919type InfoEndpoint c = c :> "info" :> Get '[JSON] [DeploymentInfo]

2020type StatusEndpoint c = c :> "status" :> Get '[JSON] DeploymentStatus

2121

src/DMC.hs+3−2

@@ -127,7 +127,8 @@ handleUpdate :: DeploymentName -> DeploymentTag -> ReaderT ClientEnv IO ()

127127handleUpdate dName dTag = do

128128 clientEnv <- ask

129129 liftIO $ do

130− response <- runClientM (updateH dName dTag) clientEnv

130+ let dUpdate = DeploymentUpdate { newTag = dTag, newEnvs = [] }

131+ response <- runClientM (updateH dName dUpdate) clientEnv

131132 handleResponse (const $ pure ()) response

132133

133134handleInfo :: DeploymentName -> ReaderT ClientEnv IO ()

@@ -150,7 +151,7 @@ editH :: DeploymentName -> EnvPairs -> ClientM NoContent

150151

151152destroyH :: DeploymentName -> ClientM NoContent

152153

153−updateH :: DeploymentName -> DeploymentTag -> ClientM NoContent

154+updateH :: DeploymentName -> DeploymentUpdate -> ClientM NoContent

154155

155156infoH :: DeploymentName -> ClientM [DeploymentInfo]

156157

src/DMS.hs+6−5

@@ -267,15 +267,16 @@ deleteDeployment :: PgPool -> DeploymentName -> IO Int64

267267deleteDeployment p n = withResource p $ \conn ->

268268 execute conn "DELETE FROM deployments WHERE name = ?" (Only n)

269269

270−updateH :: DeploymentName -> DeploymentTag -> AppM NoContent

271−updateH dName dTag = do

270+updateH :: DeploymentName -> DeploymentUpdate -> AppM NoContent

271+updateH dName DeploymentUpdate { newTag = dTag, newEnvs = dEnvs } = do

272272 st <- ask

273− let

274− pgPool = pool st

273+ let pgPool = pool st

275274 retrieved <- liftIO $ selectEnvPairs pgPool dName

276275 case retrieved of

277276 storedEnv : _ -> do

278− envPairs <- liftIO $ parseEnvs $ lines storedEnv

277+ envPairs <- liftIO $ case dEnvs of

278+ [] -> parseEnvs $ lines storedEnv

279+ _ -> pure dEnvs

279280 let

280281 log = logInfo (logger st)

281282 args = [ "--project-name", coerce $ project_name st

src/Types.hs+7

@@ -84,6 +84,13 @@ data DeploymentFullInfo = DeploymentFullInfo

8484 deriving (Generic, Show)

8585 deriving (FromJSON, ToJSON) via Snake DeploymentFullInfo

8686

87+data DeploymentUpdate = DeploymentUpdate

88+ { newTag :: DeploymentTag

89+ , newEnvs :: EnvPairs

90+ }

91+ deriving (Generic, Show)

92+ deriving (FromJSON, ToJSON) via Snake DeploymentUpdate

93+

8794data Status

8895 = Ok

8996 | Error