bda2bab · obelisk · git.iko.soy

git.iko.soy/obelisk

Use the new logging process in thunk commands

Also simplify the verbose error message

commitbda2bab24e4f03e8d8acce55da562bfacc241b21 authorSridhar Ratnakumar <srid@srid.ca> dateSun 13 May 2018, 15:00 (8 years ago) parenta90cc28

6 files changed+65−60

compare with master

unifiedsplit

lib/command/src/Obelisk/CLI/Process.hs+3−2 lib/command/src/Obelisk/Command.hs+1−1 lib/command/src/Obelisk/Command/Deploy.hs+20−17 lib/command/src/Obelisk/Command/Project.hs+9−8 lib/command/src/Obelisk/Command/Thunk.hs+24−25 lib/command/src/Obelisk/Command/Utils.hs+8−7

lib/command/src/Obelisk/CLI/Process.hs+3−2

@@ -28,7 +28,8 @@ import System.IO (Handle)

2828import System.IO.Streams (InputStream, handleToInputStream)

2929import qualified System.IO.Streams as Streams

3030import System.IO.Streams.Concurrent (concurrentMerge)

31−import System.Process

31+import System.Process (CreateProcess, StdStream (CreatePipe), cmdspec, createProcess, std_err, std_out,

32+ waitForProcess)

3233

3334import Obelisk.CLI.Logging (Output, Severity (..), failWith, putLogRaw)

3435

@@ -67,7 +68,7 @@ withProcess process action = do

6768 ExitSuccess -> return ()

6869 ExitFailure code -> do

6970 -- Log an error. We also fail immediately; however we should probably let the caller control that.

70− failWith $ T.pack $ "Process " <> show process <> " failed with exit code: " <> show code

71+ failWith $ T.pack $ show (cmdspec process) <> " failed with exit code: " <> show code

7172 return (out, err) -- Return the handles

7273

7374-- | Read from an input stream and log its contents

lib/command/src/Obelisk/Command.hs+1−1

@@ -241,7 +241,7 @@ ob = \case

241241 let deployDir = _deployInitOpts_ouputDir deployOpts

242242 sshKeyPath = _deployInitOpts_sshKey deployOpts

243243 hostname = _deployInitOpts_hostname deployOpts

244− liftIO $ deployInit thunkPtr (root </> "config") deployDir sshKeyPath hostname

244+ deployInit thunkPtr (root </> "config") deployDir sshKeyPath hostname

245245 DeployCommand_Push -> deployPush "."

246246 DeployCommand_Update -> deployUpdate "."

247247 ObCommand_Run -> inNixShell' $ static run

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

@@ -18,29 +18,32 @@ import System.Posix.Files

1818import System.Process

1919

2020import Obelisk.App (MonadObelisk)

21−import Obelisk.CLI (failWith)

21+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith)

2222import Obelisk.Command.Nix

2323import Obelisk.Command.Thunk

2424import Obelisk.Command.Utils

2525

26−deployInit :: ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> IO ()

26+deployInit :: MonadObelisk m => ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> m ()

2727deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do

28− createDirectoryIfMissing True deployDir

29− hasConfigDir <- doesDirectoryExist configDir

28+ hasConfigDir <- liftIO $ do

29+ createDirectoryIfMissing True deployDir

30+ doesDirectoryExist configDir

3031 when hasConfigDir $ do

31− cp

32− [ "-r"

33− , "-T"

34− , configDir

35− , deployDir </> "config"

36− ]

37− keyExists <- doesFileExist sshKeyPath

38− when keyExists $ do

39− target <- makeAbsolute sshKeyPath

40− createSymbolicLink target (deployDir </> "ssh_key")

41− createThunk (deployDir </> "src") thunkPtr

42− writeFile (deployDir </> "backend_hosts") $ unlines hostnames

43− initGit deployDir

32+ callProcessAndLogOutput Notice $

33+ cp

34+ [ "-r"

35+ , "-T"

36+ , configDir

37+ , deployDir </> "config"

38+ ]

39+ liftIO $ do

40+ keyExists <- doesFileExist sshKeyPath

41+ when keyExists $ do

42+ target <- makeAbsolute sshKeyPath

43+ createSymbolicLink target (deployDir </> "ssh_key")

44+ createThunk (deployDir </> "src") thunkPtr

45+ writeFile (deployDir </> "backend_hosts") $ unlines hostnames

46+ initGit deployDir

4447

4548deployPush :: MonadObelisk m => FilePath -> m ()

4649deployPush deployPath = do

lib/command/src/Obelisk/Command/Project.hs+9−8

@@ -29,7 +29,7 @@ import GitHub.Data.GitData (Branch)

2929import GitHub.Data.Name (Name)

3030

3131import Obelisk.App (MonadObelisk)

32−import Obelisk.CLI (Severity (..), failWith, putLog, withSpinner)

32+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

3333import Obelisk.Command.Thunk

3434import Obelisk.Command.Utils (cp)

3535--TODO: Make this module resilient to random exceptions

@@ -71,13 +71,14 @@ initProject source = do

7171 --TODO: We should probably handoff to the impl here

7272 skeleton <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

7373 withSpinner "Copying project skeleton" $ do

74− liftIO $ cp --TODO: Make this package depend on nix-prefetch-url properly

75− [ "-r"

76− , "--no-preserve=mode"

77− , "-T"

78− , skeleton </> "."

79− , "."

80− ]

74+ callProcessAndLogOutput Notice $

75+ cp --TODO: Make this package depend on nix-prefetch-url properly

76+ [ "-r"

77+ , "--no-preserve=mode"

78+ , "-T"

79+ , skeleton </> "."

80+ , "."

81+ ]

8182

8283--TODO: Handle errors

8384--TODO: Allow the user to ignore our security concerns

lib/command/src/Obelisk/Command/Thunk.hs+24−25

@@ -71,7 +71,7 @@ import System.Process (StdStream (CreatePipe), callProcess, createProcess, proc,

7171import Development.Placeholders

7272import Obelisk.App (MonadObelisk)

7373import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

74−import Obelisk.Command.Utils (callProcessNixShell, checkGitCleanStatus, cp)

74+import Obelisk.Command.Utils (checkGitCleanStatus, cp, procWithPackages)

7575

7676--TODO: Support symlinked thunk data

7777data ThunkData

@@ -472,36 +472,35 @@ unpackThunk thunkDir = readThunk thunkDir >>= \case

472472 Nothing -> fail "Cannot determine clone URI for thunk source"

473473 Just c -> return $ T.unpack $ getUrl c

474474 withSpinner ("Retrieving thunk " <> T.pack thunkName <> " from GitHub") $ do

475− callProcessAndLogOutput Notice (proc "hub" ["clone", "-n", githubURI, tmpRepo])

476− let obGitDir = tmpRepo </> ".git" </> "obelisk"

477− --If this directory already exists then something is weird and we should fail

478− liftIO $ createDirectory obGitDir

479− withSpinner ("Copying thunk " <> T.pack thunkName <> " to " <> T.pack thunkDir) $ do

480− liftIO $ cp

481− [ "-r"

482− , "-T"

483− , thunkDir </> "."

484− , obGitDir </> "orig-thunk"

485− ]

486− let checkoutOptions = concat

475+ callProcessAndLogOutput Notice $

476+ proc "hub" ["clone", "-n", githubURI, tmpRepo]

477+ let obGitDir = tmpRepo </> ".git" </> "obelisk"

478+ --If this directory already exists then something is weird and we should fail

479+ liftIO $ createDirectory obGitDir

480+ callProcessAndLogOutput Notice $

481+ cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]

482+ withSpinner ("Preparing thunk in " <> T.pack thunkDir) $ do

483+ -- Checkout

484+ putLog Notice $ "Checking out " <> T.pack (show $ maybe "" untagName $ _gitHubSource_branch s)

485+ callProcessAndLogOutput Debug $

486+ proc "hub" $ concat

487487 [ ["-C", tmpRepo]

488488 , pure "checkout"

489489 , maybe [] (\n -> ["-B", T.unpack (untagName n)]) (_gitHubSource_branch s)

490490 , pure $ Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr

491491 ]

492− liftIO $ do

493− callProcess "hub" checkoutOptions

492+ -- Set upstream branch

494493 forM_ (_gitHubSource_branch s) $ \branch ->

495− callProcess "hub" ["-C", tmpRepo, "branch", "-u", "origin/" <> T.unpack (untagName branch)]

496− callProcess "rm"

497− [ "-r"

498− , thunkDir

499− ]

500− callProcessNixShell ["coreutils"] "mv"

501− [ "-T"

502− , tmpRepo

503− , thunkDir

504− ]

494+ callProcessAndLogOutput Debug $

495+ proc "hub" ["-C", tmpRepo, "branch", "-u", "origin/" <> T.unpack (untagName branch)]

496+ callProcessAndLogOutput Notice $

497+ proc "rm" ["-r", thunkDir]

498+ callProcessAndLogOutput Notice $

499+ procWithPackages ["coreutils"] "mv"

500+ [ "-T"

501+ , tmpRepo

502+ , thunkDir

503+ ]

505504 ThunkSource_Git _s -> do

506505 $notImplemented

507506

lib/command/src/Obelisk/Command/Utils.hs+8−7

@@ -2,10 +2,9 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Obelisk.Command.Utils where

5−import qualified Data.List as L

65import Data.Semigroup ((<>))

76import qualified Data.Text as T

8−import System.Process

7+import System.Process (CreateProcess, callProcess, proc, readProcess)

109-- Check whether the working directory is clean

1110checkGitCleanStatus :: FilePath -> IO Bool

@@ -23,11 +22,13 @@ initGit dir = do

2322 git ["add", "."]

2423 git ["commit", "-m", "Initial commit."]

2524

26−callProcessNixShell :: [String] -> FilePath -> [String] -> IO ()

27−callProcessNixShell pkgs cmd args = callProcess "nix-shell" $

28− "-p" : pkgs <> ["--run", L.intercalate " " $ cmd : map quoteAndEscape args]

25+-- | Like `System.Process.proc` but with the specified Nix packages installed

26+procWithPackages :: [String] -> FilePath -> [String] -> CreateProcess

27+procWithPackages pkgs cmd args = proc "nix-shell" $

28+ "-p" : pkgs <> ["--run", unwords $ cmd : map quoteAndEscape args]

2929 where

3030 quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

3131

32−cp :: [String] -> IO ()

33−cp = callProcessNixShell ["coreutils"] "cp"

32+-- | Portable `cp` command

33+cp :: [String] -> CreateProcess

34+cp = procWithPackages ["coreutils"] "cp"