c8ff72c · obelisk · git.iko.soy

git.iko.soy/obelisk

deploy: Allow deployment activation to be skipped

commitc8ff72cd5abcf89ca688fbb1ce154334aa4a5ddd authorElliot Cameron <eacameron@gmail.com> dateMon 27 Jul 2020, 14:59 (6 years ago) parent5517e18

2 files changed+31−24

compare with master

unifiedsplit

lib/command/src/Obelisk/Command.hs+6−4 lib/command/src/Obelisk/Command/Deploy.hs+25−20

lib/command/src/Obelisk/Command.hs+6−4

@@ -138,7 +138,7 @@ packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

138138deployCommand :: ArgsConfig -> Parser DeployCommand

139139deployCommand cfg = hsubparser $ mconcat

140140 [ command "init" $ info (DeployCommand_Init <$> deployInitOpts) $ progDesc "Initialize a deployment configuration directory"

141− , command "push" $ info (DeployCommand_Push <$> remoteBuilderParser) mempty

141+ , command "push" $ info (DeployCommand_Push <$> switchConfigParser <*> remoteBuilderParser) mempty

142142 , command "test" $ info (DeployCommand_Test <$> platformP) $ progDesc "Test your obelisk project from a mobile platform."

143143 , command "update" $ info (pure DeployCommand_Update) $ progDesc "Update the deployment's src thunk to latest"

144144 ]

@@ -148,6 +148,8 @@ deployCommand cfg = hsubparser $ mconcat

148148 , command "ios" $ info ((,) <$> pure IOS <*> fmap pure (strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty

149149 ]

150150

151+ switchConfigParser = flag (Just DoActivateDeployment) Nothing (long "upload-only" <> help "Only upload the new configuration but do not activate it")

152+

151153 remoteBuilderParser :: Parser (Maybe RemoteBuilder)

152154 remoteBuilderParser =

153155 flag (if enabledByDefault then enabled else Nothing) enabled (mconcat

@@ -180,7 +182,7 @@ data RemoteBuilder = RemoteBuilder_ObeliskVM

180182

181183data DeployCommand

182184 = DeployCommand_Init DeployInitOpts

183− | DeployCommand_Push (Maybe RemoteBuilder)

185+ | DeployCommand_Push (Maybe DoActivateDeployment) (Maybe RemoteBuilder)

184186 | DeployCommand_Test (PlatformDeployment, [String])

185187 | DeployCommand_Update

186188 deriving Show

@@ -384,9 +386,9 @@ ob = \case

384386 ObCommand_Init source force -> initProject source force

385387 ObCommand_Deploy dc -> case dc of

386388 DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> deployInit deployOpts root

387− DeployCommand_Push remoteBuilder -> do

389+ DeployCommand_Push doActivate remoteBuilder -> do

388390 deployPath <- liftIO $ canonicalizePath "."

389− deployPush deployPath $ case remoteBuilder of

391+ deployPush deployPath doActivate $ case remoteBuilder of

390392 Nothing -> pure []

391393 Just RemoteBuilder_ObeliskVM -> (:[]) <$> VmBuilder.getNixBuildersArg

392394 DeployCommand_Update -> deployUpdate "."

lib/command/src/Obelisk/Command/Deploy.hs+25−20

@@ -49,6 +49,8 @@ data DeployInitOpts = DeployInitOpts

4949 , _deployInitOpts_enableHttps :: Bool

5050 } deriving Show

5151

52+data DoActivateDeployment = DoActivateDeployment deriving (Eq, Ord, Show)

53+

5254deployInit :: MonadObelisk m => DeployInitOpts -> FilePath -> m ()

5355deployInit deployOpts root = do

5456 let deployDir = _deployInitOpts_outputDir deployOpts

@@ -118,8 +120,8 @@ setupObeliskImpl deployDir = liftIO $ do

118120 createDirectoryIfMissing True implDir

119121 writeFile (implDir </> "default.nix") $ "(import " <> toNixPath (goBackUp </> "src") <> " {}).obelisk"

120122

121−deployPush :: MonadObelisk m => FilePath -> m [String] -> m ()

122−deployPush deployPath getNixBuilders = do

123+deployPush :: MonadObelisk m => FilePath -> Maybe DoActivateDeployment -> m [String] -> m ()

124+deployPush deployPath doActivateDeployment getNixBuilders = do

123125 hosts <- Set.fromList . filter (/= mempty) . lines <$> readDeployConfig deployPath "backend_hosts"

124126 adminEmail <- readDeployConfig deployPath "admin_email"

125127 enableHttps <- read <$> readDeployConfig deployPath "enable_https"

@@ -167,25 +169,28 @@ deployPush deployPath getNixBuilders = do

167169 callProcess'

168170 (Map.fromList [("NIX_SSHOPTS", unwords sshOpts)])

169171 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]

170− withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

171− callProcessAndLogOutput (Notice, Warning) $

172− proc "rsync"

173− [ "-e ssh " <> unwords sshOpts

174− , "-qarvz"

175− , deployPath </> "config"

176− , "root@" <> host <> ":/var/lib/backend"

177− ]

178− --TODO: Create GC root so we're sure our closure won't go away during this time period

179− withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

180− callProcessAndLogOutput (Notice, Warning) $

181− proc "ssh" $ sshOpts <>

182− [ "root@" <> host

183− , unwords

184− [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath

185− , "&&"

186− , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"

172+ case doActivateDeployment of

173+ Nothing -> putLog Warning "Skipping activation of deployment; server is unchanged"

174+ Just _ -> do

175+ withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

176+ callProcessAndLogOutput (Notice, Warning) $

177+ proc "rsync"

178+ [ "-e ssh " <> unwords sshOpts

179+ , "-qarvz"

180+ , deployPath </> "config"

181+ , "root@" <> host <> ":/var/lib/backend"

182+ ]

183+ --TODO: Create GC root so we're sure our closure won't go away during this time period

184+ withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

185+ callProcessAndLogOutput (Notice, Warning) $

186+ proc "ssh" $ sshOpts <>

187+ [ "root@" <> host

188+ , unwords

189+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath

190+ , "&&"

191+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"

192+ ]

187193 ]

188− ]

189194 isClean <- checkGitCleanStatus deployPath True

190195 when (not isClean) $ do

191196 withSpinner "Committing changes to Git" $ do