git.iko.soy/obelisk
on master help sign in
Rearrange deployPush to avoid partial pattern and improve errors
8fa7f93Tom Smalley
lib/command/src/Obelisk/Command/Deploy.hs+24−32
compare with master
unifiedsplit
@@ -88,40 +88,32 @@ deployPush deployPath getNixBuilders = do
88 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
88 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
89 routeHost <- getHostFromRoute enableHttps route
89 routeHost <- getHostFromRoute enableHttps route
90 let srcPath = deployPath </> "src"
90 let srcPath = deployPath </> "src"
91− Right (ThunkData_Packed thunkPtr) <- readThunk srcPath
92− let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
93− build = do
94− builders <- getNixBuilders
95− buildOutput <- nixBuild $ def
96− { _nixBuildConfig_target = Target
97− { _target_path = srcPath
98− , _target_attr = Just "server.system"
99− }
100− , _nixBuildConfig_outLink = OutLink_None
101− , _nixBuildConfig_args =
102− [ strArg "hostName" host
103− , strArg "adminEmail" adminEmail
104− , strArg "routeHost" routeHost
105− , strArg "version" version
106− , boolArg "enableHttps" enableHttps
107− , rawArg "config" $ deployPath </> "config"
108− ]
109− , _nixBuildConfig_builders = builders
110− }
111− return $ listToMaybe $ lines buildOutput
112− result <- readThunk srcPath >>= \case
91+ thunkPtr <- readThunk srcPath >>= \case
113− Right (ThunkData_Packed _) ->
92+ Right (ThunkData_Packed ptr) -> return ptr
114− build
115 Right (ThunkData_Checkout _) -> do
93 Right (ThunkData_Checkout _) -> do
116 checkGitCleanStatus srcPath True >>= \case
94 checkGitCleanStatus srcPath True >>= \case
117− True -> do
118− result <- build
119− packThunk srcPath
95+ True -> packThunk srcPath
120− return result
121− False -> do
122− _ <- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
96+ False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
123− return Nothing
97+ Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
124− _ -> return Nothing
98+ let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
99+ builders <- getNixBuilders
100+ buildOutput <- nixBuild $ def
101+ { _nixBuildConfig_target = Target
102+ { _target_path = srcPath
103+ , _target_attr = Just "server.system"
104+ }
105+ , _nixBuildConfig_outLink = OutLink_None
106+ , _nixBuildConfig_args =
107+ [ strArg "hostName" host
108+ , strArg "adminEmail" adminEmail
109+ , strArg "routeHost" routeHost
110+ , strArg "version" version
111+ , boolArg "enableHttps" enableHttps
112+ , rawArg "config" $ deployPath </> "config"
113+ ]
114+ , _nixBuildConfig_builders = builders
115+ }
116+ let result = listToMaybe $ lines buildOutput
125 forM_ result $ \res -> do
117 forM_ result $ \res -> do
126 let knownHostsPath = deployPath </> "backend_known_hosts"
118 let knownHostsPath = deployPath </> "backend_known_hosts"
127 sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
119 sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
lib/command/src/Obelisk/Command/Thunk.hs+4−3
@@ -553,7 +553,7 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do
553 return tmpThunk
553 return tmpThunk
554 Right _ -> failWith $ "Thunk is not packed"
554 Right _ -> failWith $ "Thunk is not packed"
555 updateThunkFromTmp p' = do
555 updateThunkFromTmp p' = do
556− packThunk' True p'
556+ _ <- packThunk' True p'
557 callProcessAndLogOutput (Notice, Error) $
557 callProcessAndLogOutput (Notice, Error) $
558 proc "cp" ["-r", "-T", p', p]
558 proc "cp" ["-r", "-T", p', p]
559
559
@@ -597,10 +597,10 @@ unpackThunk' noTrail thunkDir = readThunk thunkDir >>= \case
597
597
598--TODO: add force mode to pack even if changes are present
598--TODO: add force mode to pack even if changes are present
599--TODO: add a rollback mode to pack to the original thunk
599--TODO: add a rollback mode to pack to the original thunk
600−packThunk :: MonadObelisk m => FilePath -> m ()
600+packThunk :: MonadObelisk m => FilePath -> m ThunkPtr
601packThunk = packThunk' False
601packThunk = packThunk' False
602
602
603−packThunk' :: MonadObelisk m => Bool -> FilePath -> m ()
603+packThunk' :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr
604packThunk' noTrail thunkDir = readThunk thunkDir >>= \case
604packThunk' noTrail thunkDir = readThunk thunkDir >>= \case
605 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
605 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
606 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
606 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
@@ -610,6 +610,7 @@ packThunk' noTrail thunkDir = readThunk thunkDir >>= \case
610 thunkPtr <- getThunkPtr thunkDir
610 thunkPtr <- getThunkPtr thunkDir
611 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]
611 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]
612 liftIO $ createThunk thunkDir thunkPtr
612 liftIO $ createThunk thunkDir thunkPtr
613+ pure thunkPtr
613
614
614getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr
615getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr
615getThunkPtr = getThunkPtr' True
616getThunkPtr = getThunkPtr' True