module Propellor.DotDir
	( distrepo
	, dotPropellor
	, interactiveInit
	, checkRepoUpToDate
	) where

import Propellor.Message
import Propellor.Bootstrap
import Propellor.Git
import Propellor.Gpg
import Propellor.Types.Result
import Utility.UserInfo
import Utility.Monad
import Utility.Process
import Utility.SafeCommand
import Utility.Exception
import Utility.Directory
import Utility.Path
-- This module is autogenerated by the build system.
import qualified Paths_propellor as Package

import Data.Char
import Data.List
import Data.Version
import Control.Monad
import Control.Monad.IfElse
import System.FilePath
import System.Posix.Directory
import System.IO
import System.Console.Concurrent
import Control.Applicative
import Prelude

distdir :: FilePath
distdir :: String
distdir = String
"/usr/src/propellor"

-- A distribution may include a bundle of propellor's git repository here.
-- If not, it will be pulled from the network when needed.
distrepo :: FilePath
distrepo :: String
distrepo = String
distdir String -> String -> String
</> String
"propellor.git"

-- File containing the head rev of the distrepo.
disthead :: FilePath
disthead :: String
disthead = String
distdir String -> String -> String
</> String
"head"

upstreambranch :: String
upstreambranch :: String
upstreambranch = String
"upstream/master"

-- Using the joeyh.name mirror of the main propellor repo because
-- it is accessible over https for better security.
netrepo :: String
netrepo :: String
netrepo = String
"https://git.joeyh.name/git/propellor.git"

dotPropellor :: IO FilePath
dotPropellor :: IO String
dotPropellor = do
	home <- IO String
myHomeDir
	return (home </> ".propellor")

-- Detect if propellor was built using stack. This is somewhat of a hack.
buildSystem :: IO String
buildSystem :: IO String
buildSystem = do
	d <- IO String
Package.getLibDir
	return $ if "stack-work" `isInfixOf` d then "stack" else "cabal"

interactiveInit :: IO ()
interactiveInit :: IO ()
interactiveInit = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> IO String -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor)
	( String -> IO ()
forall a. HasCallStack => String -> a
error String
"~/.propellor/ already exists, not doing anything"
	, do
		IO ()
welcomeBanner
		IO ()
setup
	)

-- | Determine whether we need to create a cabal sandbox in ~/.propellor/,
-- which we do if the user has configured cabal to require a sandbox, and the
-- build system is cabal.
cabalSandboxRequired :: IO Bool
cabalSandboxRequired :: IO Bool
cabalSandboxRequired = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
cabal
	( do
		home <- IO String
myHomeDir
		ls <- lines <$> catchDefaultIO []
			(readFile (home </> ".cabal" </> "config"))
		-- For simplicity, we assume a sane ~/.cabal/config here:
		return $ any ("True" `isInfixOf`) $
			filter ("require-sandbox:" `isPrefixOf`) ls
	, Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
	)
  where
	cabal :: IO Bool
cabal = IO String
buildSystem IO String -> (String -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
bSystem -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
bSystem String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cabal")

say :: String -> IO ()
say :: String -> IO ()
say = String -> IO ()
forall v. Outputable v => v -> IO ()
outputConcurrent

sayLn :: String -> IO ()
sayLn :: String -> IO ()
sayLn String
s = String -> IO ()
say (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")

welcomeBanner :: IO ()
welcomeBanner :: IO ()
welcomeBanner = String -> IO ()
say (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
prettify
	[ String
""
	, String
""
	, String
"                                 _         ______`|                     ,-.__"
	, String
" .---------------------------  /   ~___-=O`/|O`/__|                    (____.'"
	, String
"  - Welcome to              -- ~          / | /    )        _.-'-._"
	, String
"  -            Propellor!   --  `/-==__ _/__|/__=-|        (       ~_"
	, String
" `---------------------------   *             ~ | |         '--------'"
	, String
"                                            (o)  `"
	, String
""
	, String
""
	]
  where
	prettify :: String -> String
prettify = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char -> Char
forall {p}. Eq p => p -> p -> p -> p
replace Char
'~' Char
'\\')
	replace :: p -> p -> p -> p
replace p
x p
y p
c
		| p
c p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
x = p
y
		| Bool
otherwise = p
c

prompt :: String -> [(String, IO ())] -> IO ()
prompt :: String -> [(String, IO ())] -> IO ()
prompt String
p [(String, IO ())]
cs = do
	String -> IO ()
say (String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (((String, IO ()) -> String) -> [(String, IO ())] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, IO ()) -> String
forall a b. (a, b) -> a
fst [(String, IO ())]
cs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] ")
	IO ()
flushConcurrentOutput
	Handle -> IO ()
hFlush Handle
stdout
	r <- (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getLine
	if null r
		then snd (head cs) -- default to first choice on return
		else case filter (\(String
s, IO ()
_) -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
r) cs of
			[(String
_, IO ()
a)] -> IO ()
a
			[(String, IO ())]
_ -> do
				String -> IO ()
sayLn String
"Not a valid choice, try again.. (Or ctrl-c to quit)"
				String -> [(String, IO ())] -> IO ()
prompt String
p [(String, IO ())]
cs

section :: IO ()
section :: IO ()
section = do
	String -> IO ()
sayLn String
""
	String -> IO ()
sayLn String
"------------------------------------------------------------------------------"
	String -> IO ()
sayLn String
""

setup :: IO ()
setup :: IO ()
setup = do
	String -> IO ()
sayLn String
"Propellor's configuration file is ~/.propellor/config.hs"
	String -> IO ()
sayLn String
""
	String -> IO ()
sayLn String
"Let's get you started with a simple config that you can adapt"
	String -> IO ()
sayLn String
"to your needs. You can start with:"
	String -> IO ()
sayLn String
"   A: A clone of propellor's git repository    (most flexible)"
	String -> IO ()
sayLn String
"   B: The bare minimum files to use propellor  (most simple)"
	String -> [(String, IO ())] -> IO ()
prompt String
"Which would you prefer?"
		[ (String
"A", IO Result -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
String -> m r -> m r
actionMessage String
"Cloning propellor's git repository" IO Result
fullClone)
		, (String
"B", IO Result -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Result -> IO ()) -> IO Result -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
String -> m r -> m r
actionMessage String
"Creating minimal config" IO Result
minimalConfig)
		]
	String -> IO ()
changeWorkingDirectory (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor

	IO ()
section
	String -> IO ()
sayLn String
"Let's try building the propellor configuration, to make sure it will work..."
	String -> IO ()
sayLn String
""
	b <- IO String
buildSystem
	void $ boolSystem "git"
		[ Param "config"
		, Param "propellor.buildsystem"
		, Param b
		]
	ifM cabalSandboxRequired
		( void $ boolSystem "cabal"
			[ Param "sandbox"
			, Param "init"
			]
		, return ()
		)
	buildPropellor Nothing
	sayLn ""
	sayLn "Great! Propellor is bootstrapped."

	section
	sayLn "Propellor can use gpg to encrypt private data about the systems it manages,"
	sayLn "and to sign git commits."
	gpg <- getGpgBin
	ifM (inPath gpg)
		( setupGpgKey
		, do
			sayLn "You don't seem to have gpg installed, so skipping setting it up."
			explainManualSetupGpgKey
		)

	section
	sayLn "Everything is set up ..."
	sayLn "Your next step is to edit ~/.propellor/config.hs"
	sayLn "and run propellor again to try it out."
	sayLn ""
	sayLn "For docs, see https://propellor.branchable.com/"
	sayLn "Enjoy propellor!"

explainManualSetupGpgKey :: IO ()
explainManualSetupGpgKey :: IO ()
explainManualSetupGpgKey = do
	String -> IO ()
sayLn String
"Propellor can still be used without gpg, but it won't be able to"
	String -> IO ()
sayLn String
"manage private data. You can set this up later:"
	String -> IO ()
sayLn String
" 1. gpg --gen-key"
	String -> IO ()
sayLn String
" 2. propellor --add-key (pass it the key ID generated in step 1)"

setupGpgKey :: IO ()
setupGpgKey :: IO ()
setupGpgKey = do
	ks <- IO [(String, String)]
listSecretKeys
	sayLn ""
	case ks of
		[] -> IO ()
makeGpgKey
		[(String
k, String
d)] -> do
			String -> IO ()
sayLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"You have one gpg key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
desckey String
k String
d
			String -> [(String, IO ())] -> IO ()
prompt String
"Should propellor use that key?"
				[ (String
"Y", String -> IO ()
propellorAddKey String
k)
				, (String
"N", String -> IO ()
sayLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Skipping gpg setup. If you change your mind, run: propellor --add-key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k)
				]
		[(String, String)]
_ -> do
			let nks :: [((String, String), String)]
nks = [(String, String)] -> [String] -> [((String, String), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, String)]
ks ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show ([Integer
1..] :: [Integer]))
			String -> IO ()
sayLn String
"I see you have several gpg keys:"
			[((String, String), String)]
-> (((String, String), String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((String, String), String)]
nks ((((String, String), String) -> IO ()) -> IO ())
-> (((String, String), String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \((String
k, String
d), String
n) ->
				String -> IO ()
sayLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
desckey String
k String
d
			String -> [(String, IO ())] -> IO ()
prompt String
"Which of your gpg keys should propellor use?"
				((((String, String), String) -> (String, IO ()))
-> [((String, String), String)] -> [(String, IO ())]
forall a b. (a -> b) -> [a] -> [b]
map (\((String
k, String
_), String
n) -> (String
n, String -> IO ()
propellorAddKey String
k)) [((String, String), String)]
nks)
  where
	desckey :: String -> String -> String
desckey String
k String
d = String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  (keyid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

makeGpgKey :: IO ()
makeGpgKey :: IO ()
makeGpgKey = do
	String -> IO ()
sayLn String
"You seem to not have any gpg secret keys."
	String -> [(String, IO ())] -> IO ()
prompt String
"Would you like to create one now?"
		[(String
"Y", IO ()
rungpg), (String
"N", IO ()
nope)]
  where
	nope :: IO ()
nope = do
		String -> IO ()
sayLn String
"No problem."
		IO ()
explainManualSetupGpgKey
	rungpg :: IO ()
rungpg = do
		String -> IO ()
sayLn String
"Running gpg --gen-key ..."
		gpg <- IO String
getGpgBin
		void $ boolSystem gpg [Param "--gen-key"]
		ks <- listSecretKeys
		case ks of
			[] -> do
				String -> IO ()
sayLn String
"Hmm, gpg seemed to not set up a secret key."
				String -> [(String, IO ())] -> IO ()
prompt String
"Want to try running gpg again?"
					[(String
"Y", IO ()
rungpg), (String
"N", IO ()
nope)]
			((String
k, String
_):[(String, String)]
_) -> String -> IO ()
propellorAddKey String
k

propellorAddKey :: String -> IO ()
propellorAddKey :: String -> IO ()
propellorAddKey String
keyid = do
	String -> IO ()
sayLn String
""
	String -> IO ()
sayLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Telling propellor to use your gpg key by running: propellor --add-key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
keyid
	d <- IO String
dotPropellor
	unlessM (boolSystem (d </> "propellor") [Param "--add-key", Param keyid]) $ do
		sayLn "Oops, that didn't work! You can retry the same command later."
		sayLn "Continuing onward ..."

minimalConfig :: IO Result
minimalConfig :: IO Result
minimalConfig = do
	d <- IO String
dotPropellor
	createDirectoryIfMissing True d
	changeWorkingDirectory d
	void $ boolSystem "git" [Param "init"]
	addfile "config.cabal" cabalcontent
	addfile "config.hs" configcontent
	addfile "stack.yaml" stackcontent
	return MadeChange
  where
	addfile :: String -> [String] -> IO ()
addfile String
f [String]
content = do
		String -> String -> IO ()
writeFile String
f ([String] -> String
unlines [String]
content)
		IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"add" , String -> CommandParam
File String
f]
	cabalcontent :: [String]
cabalcontent =
		[ String
"-- This is a cabal file to use to build your propellor configuration."
		, String
""
		, String
"Name: config"
		, String
"Cabal-Version: >= 1.6"
		, String
"Build-Type: Simple"
		, String
"Version: 0"
		, String
""
		, String
"Executable propellor-config"
		, String
"  Main-Is: config.hs"
		, String
"  GHC-Options: -threaded -Wall -fno-warn-tabs -O0"
		, String
"  Extensions: TypeOperators"
		, String
"  Build-Depends: propellor >= 3.0, base >= 4.9"
		]
	configcontent :: [String]
configcontent =
		[ String
"-- This is the main configuration file for Propellor, and is used to build"
		, String
"-- the propellor program.    https://propellor.branchable.com/"
		, String
""
		, String
"import Propellor"
		, String
"import qualified Propellor.Property.File as File"
		, String
"import qualified Propellor.Property.Apt as Apt"
		, String
"import qualified Propellor.Property.Cron as Cron"
		, String
"import qualified Propellor.Property.User as User"
		, String
""
		, String
"main :: IO ()"
		, String
"main = defaultMain hosts"
		, String
""
		, String
"-- The hosts propellor knows about."
		, String
"hosts :: [Host]"
		, String
"hosts ="
		, String
"        [ mybox"
		, String
"        ]"
		, String
""
		, String
"-- An example host."
		, String
"mybox :: Host"
		, String
"mybox = host \"mybox.example.com\" $ props"
		, String
"        & osDebian Unstable X86_64"
		, String
"        & Apt.stdSourcesList"
		, String
"        & Apt.unattendedUpgrades"
		, String
"        & Apt.installed [\"etckeeper\"]"
		, String
"        & Apt.installed [\"ssh\"]"
		, String
"        & User.hasSomePassword (User \"root\")"
		, String
"        & File.dirExists \"/var/www\""
		, String
"        & Cron.runPropellor (Cron.Times \"30 * * * *\")"
		, String
""
		]
	stackcontent :: [String]
stackcontent =
		-- This should be the same resolver version in propellor's
		-- own stack.yaml
		[ String
"resolver: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
stackResolver
		, String
"packages:"
		, String
"- '.'"
		, String
"extra-deps:"
		, String
"- propellor-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
Package.version
		]

stackResolver :: String
stackResolver :: String
stackResolver = String
"lts-9.21"

fullClone :: IO Result
fullClone :: IO Result
fullClone = do
	d <- IO String
dotPropellor
	let enterdotpropellor = String -> IO ()
changeWorkingDirectory String
d IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
	ok <- ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
		( allM id
			[ boolSystem "git" [Param "clone", File distrepo, File d]
			, fetchUpstreamBranch distrepo
			, enterdotpropellor
			, boolSystem "git" [Param "remote", Param "rm", Param "origin"]
			]
		, allM id
			[ boolSystem "git" [Param "clone", Param netrepo, File d]
			, enterdotpropellor
			-- Rename origin to upstream and avoid
			-- git push to that read-only repo.
			, boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
			, boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
			]
		)
	return (toResult ok)

fetchUpstreamBranch :: FilePath -> IO Bool
fetchUpstreamBranch :: String -> IO Bool
fetchUpstreamBranch String
repo = do
	String -> IO ()
changeWorkingDirectory (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor
	String -> [CommandParam] -> IO Bool
boolSystem String
"git"
		[ String -> CommandParam
Param String
"fetch"
		, String -> CommandParam
File String
repo
		, String -> CommandParam
Param (String
"+refs/heads/master:refs/remotes/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
upstreambranch)
		, String -> CommandParam
Param String
"--quiet"
		]

checkRepoUpToDate :: IO ()
checkRepoUpToDate :: IO ()
checkRepoUpToDate = IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (IO Bool
gitbundleavail IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> IO Bool
dotpropellorpopulated) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
	headrev <- (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
disthead
	changeWorkingDirectory =<< dotPropellor
	headknown <- catchMaybeIO $
		withQuietOutput createProcessSuccess $
			proc "git" ["log", headrev]
	if (headknown == Nothing)
		then updateUpstreamMaster headrev
		else do
			theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef
			when (theirhead /= headrev) $ do
				merged <- not . null <$>
					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
				unless merged $
					warnoutofdate True
  where
	gitbundleavail :: IO Bool
gitbundleavail = String -> IO Bool
doesFileExist String
disthead
	dotpropellorpopulated :: IO Bool
dotpropellorpopulated = do
		d <- IO String
dotPropellor
		doesFileExist (d </> "propellor.cabal")

-- Updates upstream/master in dotPropellor so merging from it will update
-- to the latest distrepo.
--
-- We cannot just fetch the distrepo because the distrepo contains only 
-- 1 commit. So, trying to merge with it will result in lots of merge
-- conflicts, since git cannot find a common parent commit.
--
-- Instead, the new upstream/master branch is updated by taking the
-- current upstream/master branch (which must be an old version of propellor,
-- as distributed), and diffing from it to the current origin/master,
-- and committing the result. This is done in a temporary clone of the
-- repository, giving it a new master branch. That new branch is fetched
-- into the user's repository, as if fetching from a upstream remote,
-- yielding a new upstream/master branch.
--
-- If there's no upstream/master, or the repo is not using the distrepo,
-- do nothing.
updateUpstreamMaster :: String -> IO ()
updateUpstreamMaster :: String -> IO ()
updateUpstreamMaster String
newref = do
	String -> IO ()
changeWorkingDirectory (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor
	Maybe String -> IO ()
go (Maybe String -> IO ()) -> IO (Maybe String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe String)
getoldref
  where
	go :: Maybe String -> IO ()
go Maybe String
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	go (Just String
oldref) = do
		let tmprepo :: String
tmprepo = String
".git/propellordisttmp"
		let cleantmprepo :: IO ()
cleantmprepo = IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Maybe ())
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
tmprepo
		IO ()
cleantmprepo
		[String] -> IO ()
git [String
"clone", String
"--quiet", String
".", String
tmprepo]

		String -> IO ()
changeWorkingDirectory String
tmprepo
		[String] -> IO ()
git [String
"fetch", String
distrepo, String
"--quiet"]
		[String] -> IO ()
git [String
"reset", String
"--hard", String
oldref, String
"--quiet"]
		v <- IO Version
gitVersion
		let mergeparams =
			[ String
"merge", String
newref
			, String
"-s", String
"recursive"
			, String
"-Xtheirs"
			, String
"--quiet"
			, String
"-m", String
"merging upstream version"
			] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
2,Int
9]
				then [ String
"--allow-unrelated-histories" ]
				else []
		git mergeparams

		void $ fetchUpstreamBranch tmprepo
		cleantmprepo
		warnoutofdate True

	git :: [String] -> IO ()
git = String -> [String] -> IO ()
run String
"git"
	run :: String -> [String] -> IO ()
run String
cmd [String]
ps = IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (String -> [CommandParam] -> IO Bool
boolSystem String
cmd ((String -> CommandParam) -> [String] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param [String]
ps)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to run " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
ps

	-- Get ref that the upstreambranch points to, only when
	-- the distrepo is being used.
	getoldref :: IO (Maybe String)
getoldref = do
		mref <- IO String -> IO (Maybe String)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO String -> IO (Maybe String)) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
			(String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"git" [String
"show-ref", String
upstreambranch, String
"--hash"]
		case mref of
			Just String
_ -> do
				-- Normally there will be no upstream
				-- remote when the distrepo is used.
				-- Older versions of propellor set up
				-- an upstream remote pointing at the 
				-- distrepo.
				IO Bool
-> (IO (Maybe String), IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
hasRemote String
"upstream")
					( do
						v <- String -> IO (Maybe String)
remoteUrl String
"upstream"
						return $ case v of
							Just String
rurl | String
rurl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
distrepo -> Maybe String
mref
							Maybe String
_ -> Maybe String
forall a. Maybe a
Nothing
					, Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mref
					)
			Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mref

warnoutofdate :: Bool -> IO ()
warnoutofdate :: Bool -> IO ()
warnoutofdate Bool
havebranch = String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
	[ String
"** Your ~/.propellor/ is out of date.."
	, String -> String
indent String
"A newer upstream version is available in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
distrepo
	, String -> String
indent (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ if Bool
havebranch
		then String
"To merge it, run: git merge " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
upstreambranch
		else String
"To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
upstreambranch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to it. Then run propellor again."
	]
  where
	indent :: String -> String
indent String
s = String
"   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s