@@ -1,13 +1,27 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE LambdaCase #-}
13{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
25module Obelisk.Command.Deploy where
36
47import Control.Monad
8+import Control.Monad.Catch (finally)
9+import Control.Monad.Reader (liftIO)
10+import Data.Default
11+import Data.Maybe
12+import Data.Monoid
13+import qualified Data.Text as T
14+import qualified Data.Text.IO as T
515import System.Directory
616import System.FilePath
717import System.Posix.Files
18+import System.Process
819
9−import Obelisk.Command.Utils
20+import Obelisk.App (MonadObelisk)
21+import Obelisk.Command.CLI (failWith)
22+import Obelisk.Command.Nix
1023import Obelisk.Command.Thunk
24+import Obelisk.Command.Utils
1125
1226deployInit :: ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
1327deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
@@ -28,3 +42,46 @@ deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
2842 writeFile (deployDir </> "backend_hosts") $ unlines hostnames
2943 initGit deployDir
3044
45+deployPush :: MonadObelisk m => FilePath -> m ()
46+deployPush deployPath = do
47+ liftIO $ callProcess "ssh-add" [deployPath </> "ssh_key"]
48+ host <- liftIO $ fmap (T.unpack . T.strip) $ T.readFile $ deployPath </> "backend_hosts"
49+ let srcPath = deployPath </> "src"
50+ build = do
51+ buildOutput <- nixBuild $ def
52+ { _nixBuildConfig_target = Target
53+ { _target_path = srcPath
54+ , _target_attr = Just "server"
55+ }
56+ , _nixBuildConfig_outLink = OutLink_None
57+ , _nixBuildConfig_args = pure $ Arg "hostName" host
58+ }
59+ return $ listToMaybe $ lines buildOutput
60+ result <- readThunk srcPath >>= \case
61+ Right (ThunkData_Packed _) -> do
62+ unpackThunk srcPath
63+ build `finally` packThunk srcPath "origin" -- get upstream
64+ Right (ThunkData_Checkout _) -> do
65+ liftIO (checkGitCleanStatus srcPath) >>= \case
66+ True -> do
67+ result <- build
68+ packThunk srcPath "origin" -- get upstream
69+ return result
70+ False -> do
71+ _ <- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
72+ return Nothing
73+ _ -> return Nothing
74+ liftIO $ forM_ result $ \res -> do
75+ callProcess "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", res]
76+ callProcess "ssh"
77+ [ "root@" <> host
78+ , unwords
79+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> res
80+ , "&&"
81+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
82+ ]
83+ ]
84+ isClean <- liftIO $ checkGitCleanStatus deployPath
85+ when (not isClean) $ liftIO $ do
86+ callProcess "git" ["-C", deployPath, "add", "--update"]
87+ callProcess "git" ["-C", deployPath, "commit", "-m", "New deployment"]