git.iko.soy/obelisk
on master help sign in
ob deploy init: Initialize a deployment configuration directory
commitea03de37ad3e7a7e7dd530761e2cb55bf722818a authorLuigy Leon <luigy@outlook.com> dateTue 8 May 2018, 12:00 (8 years ago) parent8e81374
4 files changed+75−6
compare with master
unifiedsplit
lib/command/obelisk-command.cabal+1 lib/command/src/Obelisk/Command.hs+32 lib/command/src/Obelisk/Command/Deploy.hs+29 lib/command/src/Obelisk/Command/Thunk.hs+13−6
lib/command/obelisk-command.cabal+1
@@ -33,6 +33,7 @@ library
3333 , yaml
3434 exposed-modules:
3535 Obelisk.Command
36+ Obelisk.Command.Deploy
3637 Obelisk.Command.Nix
3738 Obelisk.Command.Project
3839 Obelisk.Command.Repl
lib/command/src/Obelisk/Command.hs+32
@@ -22,6 +22,7 @@ import System.IO
2222import System.Posix.Process
2323
2424import Obelisk.Command.Project
25+import Obelisk.Command.Deploy
2526import Obelisk.Command.Thunk
2627import Obelisk.Command.Repl
2728import Obelisk.Command.Run
@@ -59,6 +60,7 @@ initSource = foldl1 (<|>)
5960
6061data ObCommand
6162 = ObCommand_Init InitSource
63+ | ObCommand_Deploy DeployCommand
6264 | ObCommand_Run
6365 | ObCommand_Thunk ThunkCommand
6466 | ObCommand_Repl FilePath
@@ -82,6 +84,7 @@ obCommand :: Parser ObCommand
8284obCommand = hsubparser
8385 (mconcat
8486 [ command "init" $ info (ObCommand_Init <$> initSource) $ progDesc "Initialize an Obelisk project"
87+ , command "deploy" $ info (ObCommand_Deploy <$> deployCommand) $ progDesc "Prepare a deployment for an Obelisk project"
8588 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
8689 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
8790 , command "repl" $ info (ObCommand_Repl <$> (strArgument (action "directory"))) $ progDesc "Open an interactive interpreter"
@@ -93,6 +96,28 @@ obCommand = hsubparser
9396 , command "internal" (info (ObCommand_Internal <$> internalCommand) mempty)
9497 ])
9598
99+deployCommand :: Parser DeployCommand
100+deployCommand = hsubparser $ mconcat
101+ [ command "init" $ info deployInitCommand $ progDesc "Initialize a deployment configuration directory"
102+ ]
103+
104+deployInitCommand :: Parser DeployCommand
105+deployInitCommand = fmap DeployCommand_Init $ DeployInitOpts
106+ <$> strArgument (action "deploy-dir" <> metavar "DEPLOYDIR" <> help "Path to a directory that it will create")
107+ <*> strOption (long "ssh-key" <> metavar "SSHKEY" <> help "Path to an ssh key that it will symlink to")
108+ <*> some (strOption (long "hostname" <> metavar "HOSTNAME" <> help "hostname of the deployment target"))
109+ <*> strOption (long "remote" <> metavar "REMOTE" <> help "git remote to use for the src thunk")
110+
111+data DeployCommand
112+ = DeployCommand_Init DeployInitOpts
113+
114+data DeployInitOpts = DeployInitOpts
115+ { _deployInitOpts_ouputDir :: FilePath
116+ , _deployInitOpts_sshKey :: FilePath
117+ , _deployInitOpts_hostname :: [String]
118+ , _deployInitOpts_remote :: String
119+ }
120+
96121internalCommand :: Parser ObInternal
97122internalCommand = subparser $ mconcat
98123 [ command "run-static-io" $ info (ObInternal_RunStaticIO <$> argument (eitherReader decodeStaticKey) (action "static-key")) mempty
@@ -167,6 +192,13 @@ main = do
167192ob :: ObCommand -> IO ()
168193ob = \case
169194 ObCommand_Init source -> initProject source
195+ ObCommand_Deploy dc -> case dc of
196+ DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> do
197+ thunkPtr <- getThunkPtr root (_deployInitOpts_remote deployOpts)
198+ let deployDir = _deployInitOpts_ouputDir deployOpts
199+ sshKeyPath = _deployInitOpts_sshKey deployOpts
200+ hostname = _deployInitOpts_hostname deployOpts
201+ deployInit thunkPtr (root </> "config") deployDir sshKeyPath hostname
170202 ObCommand_Run -> inNixShell' $ static run
171203 -- inNixShell ($(mkClosure 'ghcidAction) ())
172204 ObCommand_Thunk tc -> case tc of
lib/command/src/Obelisk/Command/Deploy.hsnew file+29
@@ -0,0 +1,29 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Obelisk.Command.Deploy where
3+
4+import Control.Monad
5+import System.Directory
6+import System.FilePath
7+import System.Posix.Files
8+import System.Process
9+
10+import Obelisk.Command.Thunk
11+
12+deployInit :: ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
13+deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
14+ createDirectory deployDir
15+ hasConfigDir <- doesDirectoryExist configDir
16+ when hasConfigDir $ do
17+ callProcess "cp"
18+ [ "-r"
19+ , "-T"
20+ , configDir
21+ , deployDir </> "config"
22+ ]
23+ keyExists <- doesFileExist sshKeyPath
24+ when keyExists $ do
25+ target <- makeAbsolute sshKeyPath
26+ createSymbolicLink target (deployDir </> "ssh_key")
27+ createThunk (deployDir </> "src") thunkPtr
28+ writeFile (deployDir </> "backend_hosts") $ unlines hostnames
29+
lib/command/src/Obelisk/Command/Thunk.hs+13−6
@@ -13,12 +13,14 @@ module Obelisk.Command.Thunk
1313 , GitHubSource (..)
1414 , getLatestRev
1515 , updateThunkToLatest
16+ , createThunk
1617 , createThunkWithLatest
1718 , nixBuildAttrWithCache
1819 , nixBuildThunkAttrWithCache
1920 , unpackThunk
2021 , packThunk
2122 , readThunk
23+ , getThunkPtr
2224 ) where
2325
2426import Control.Applicative
@@ -498,6 +500,16 @@ packThunk thunkDir upstream = readThunk thunkDir >>= \case
498500 Left err -> fail $ "thunk pack: " <> show err
499501 Right (ThunkData_Packed _) -> fail "pack: thunk is already packed"
500502 Right (ThunkData_Checkout _) -> do
503+ thunkPtr <- getThunkPtr thunkDir upstream
504+ callProcess "rm"
505+ [ "-rf"
506+ , thunkDir
507+ ]
508+ createThunk thunkDir thunkPtr
509+ return ()
510+
511+getThunkPtr :: FilePath -> String -> IO ThunkPtr
512+getThunkPtr thunkDir upstream = do
501513 --Check whether the working directory is clean
502514 statusOutput <- readProcess "hub"
503515 [ "-C", thunkDir
@@ -578,12 +590,7 @@ packThunk thunkDir upstream = readThunk thunkDir >>= \case
578590 if
579591 | isGithubThunk remoteUri -> githubThunkPtr remoteUri currentHead currentUpstreamBranch
580592 | otherwise -> gitThunkPtr remoteUri currentHead currentUpstreamBranch
581− callProcess "rm"
582− [ "-rf"
583− , thunkDir
584− ]
585− createThunk thunkDir thunkPtr
586− return ()
593+ return thunkPtr
587594 where
588595 refsToTuples [x, y] = (x, y)
589596 refsToTuples x = error $ "thunk pack: cannot parse ref " <> show x