@@ -1,13 +1,22 @@
1+{-# LANGUAGE LambdaCase #-}
12{-# LANGUAGE OverloadedStrings #-}
23module Obelisk.Command.Deploy where
34
5+import Control.Exception
46import Control.Monad
7+import Data.Default
8+import Data.Maybe
9+import Data.Monoid
10+import qualified Data.Text as T
11+import qualified Data.Text.IO as T
512import System.Directory
613import System.FilePath
714import System.Posix.Files
15+import System.Process
816
9−import Obelisk.Command.Utils
17+import Obelisk.Command.Nix
1018import Obelisk.Command.Thunk
19+import Obelisk.Command.Utils
1120
1221deployInit :: ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
1322deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
@@ -28,3 +37,33 @@ deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
2837 writeFile (deployDir </> "backend_hosts") $ unlines hostnames
2938 initGit deployDir
3039
40+deployPush :: FilePath -> IO ()
41+deployPush deployPath = do
42+ callProcess "ssh-add" [deployPath </> "ssh_key"]
43+ host <- fmap (T.unpack . T.strip) $ T.readFile $ deployPath </> "backend_hosts"
44+ let srcPath = deployPath </> "src"
45+ result <- readThunk srcPath >>= \case
46+ Right (ThunkData_Packed _) -> do
47+ unpackThunk srcPath
48+ let build = do
49+ buildOutput <- nixBuild $ def
50+ { _nixBuildConfig_target = Target
51+ { _target_path = srcPath
52+ , _target_attr = Just "server"
53+ }
54+ , _nixBuildConfig_outLink = OutLink_None
55+ , _nixBuildConfig_args = pure $ Arg "hostName" host
56+ }
57+ return $ listToMaybe $ lines $ buildOutput
58+ build `finally` packThunk srcPath "origin" -- get upstream
59+ _ -> return Nothing
60+ forM_ result $ \res -> do
61+ callProcess "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", res]
62+ callProcess "ssh"
63+ [ "root@" <> host
64+ , unwords
65+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> res
66+ , "&&"
67+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
68+ ]
69+ ]