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 :: FilePath
distdir = FilePath
"/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 :: FilePath
distrepo = FilePath
distdir FilePath -> FilePath -> FilePath
</> FilePath
"propellor.git"

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

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

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

dotPropellor :: IO FilePath
dotPropellor :: IO FilePath
dotPropellor = do
	FilePath
home <- IO FilePath
myHomeDir
	FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
".propellor")

-- Detect if propellor was built using stack. This is somewhat of a hack.
buildSystem :: IO String
buildSystem :: IO FilePath
buildSystem = do
	FilePath
d <- IO FilePath
Package.getLibDir
	FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if FilePath
"stack-work" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
d then FilePath
"stack" else FilePath
"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 (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> IO FilePath -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
dotPropellor)
	( FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"~/.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
		FilePath
home <- IO FilePath
myHomeDir
		[FilePath]
ls <- FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO []
			(FilePath -> IO FilePath
readFile (FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
".cabal" FilePath -> FilePath -> FilePath
</> FilePath
"config"))
		-- For simplicity, we assume a sane ~/.cabal/config here:
		Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath
"True" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$
			(FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
"require-sandbox:" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [FilePath]
ls
	, Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
	)
  where
	cabal :: IO Bool
cabal = IO FilePath
buildSystem IO FilePath -> (FilePath -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
bSystem -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
bSystem FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"cabal")

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

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

welcomeBanner :: IO ()
welcomeBanner :: IO ()
welcomeBanner = FilePath -> IO ()
say (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
prettify
	[ FilePath
""
	, FilePath
""
	, FilePath
"                                 _         ______`|                     ,-.__"
	, FilePath
" .---------------------------  /   ~___-=O`/|O`/__|                    (____.'"
	, FilePath
"  - Welcome to              -- ~          / | /    )        _.-'-._"
	, FilePath
"  -            Propellor!   --  `/-==__ _/__|/__=-|        (       ~_"
	, FilePath
" `---------------------------   *             ~ | |         '--------'"
	, FilePath
"                                            (o)  `"
	, FilePath
""
	, FilePath
""
	]
  where
	prettify :: FilePath -> FilePath
prettify = (Char -> Char) -> FilePath -> FilePath
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 :: FilePath -> [(FilePath, IO ())] -> IO ()
prompt FilePath
p [(FilePath, IO ())]
cs = do
	FilePath -> IO ()
say (FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" [" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"|" (((FilePath, IO ()) -> FilePath)
-> [(FilePath, IO ())] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, IO ()) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, IO ())]
cs) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"] ")
	IO ()
flushConcurrentOutput
	Handle -> IO ()
hFlush Handle
stdout
	FilePath
r <- (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getLine
	if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
		then (FilePath, IO ()) -> IO ()
forall a b. (a, b) -> b
snd ([(FilePath, IO ())] -> (FilePath, IO ())
forall a. [a] -> a
head [(FilePath, IO ())]
cs) -- default to first choice on return
		else case ((FilePath, IO ()) -> Bool)
-> [(FilePath, IO ())] -> [(FilePath, IO ())]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FilePath
s, IO ()
_) -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
r) [(FilePath, IO ())]
cs of
			[(FilePath
_, IO ()
a)] -> IO ()
a
			[(FilePath, IO ())]
_ -> do
				FilePath -> IO ()
sayLn FilePath
"Not a valid choice, try again.. (Or ctrl-c to quit)"
				FilePath -> [(FilePath, IO ())] -> IO ()
prompt FilePath
p [(FilePath, IO ())]
cs

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

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

	IO ()
section
	FilePath -> IO ()
sayLn FilePath
"Let's try building the propellor configuration, to make sure it will work..."
	FilePath -> IO ()
sayLn FilePath
""
	FilePath
b <- IO FilePath
buildSystem
	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
$ FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"git"
		[ FilePath -> CommandParam
Param FilePath
"config"
		, FilePath -> CommandParam
Param FilePath
"propellor.buildsystem"
		, FilePath -> CommandParam
Param FilePath
b
		]
	IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
cabalSandboxRequired
		( 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
$ FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"cabal"
			[ FilePath -> CommandParam
Param FilePath
"sandbox"
			, FilePath -> CommandParam
Param FilePath
"init"
			]
		, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
		)
	Maybe Host -> IO ()
buildPropellor Maybe Host
forall a. Maybe a
Nothing
	FilePath -> IO ()
sayLn FilePath
""
	FilePath -> IO ()
sayLn FilePath
"Great! Propellor is bootstrapped."

	IO ()
section
	FilePath -> IO ()
sayLn FilePath
"Propellor can use gpg to encrypt private data about the systems it manages,"
	FilePath -> IO ()
sayLn FilePath
"and to sign git commits."
	FilePath
gpg <- IO FilePath
getGpgBin
	IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
inPath FilePath
gpg)
		( IO ()
setupGpgKey
		, do
			FilePath -> IO ()
sayLn FilePath
"You don't seem to have gpg installed, so skipping setting it up."
			IO ()
explainManualSetupGpgKey
		)

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

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

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

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

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

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

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

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

fetchUpstreamBranch :: FilePath -> IO Bool
fetchUpstreamBranch :: FilePath -> IO Bool
fetchUpstreamBranch FilePath
repo = do
	FilePath -> IO ()
changeWorkingDirectory (FilePath -> IO ()) -> IO FilePath -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
dotPropellor
	FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"git"
		[ FilePath -> CommandParam
Param FilePath
"fetch"
		, FilePath -> CommandParam
File FilePath
repo
		, FilePath -> CommandParam
Param (FilePath
"+refs/heads/master:refs/remotes/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
upstreambranch)
		, FilePath -> CommandParam
Param FilePath
"--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
	FilePath
headrev <- (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
disthead
	FilePath -> IO ()
changeWorkingDirectory (FilePath -> IO ()) -> IO FilePath -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
dotPropellor
	Maybe ()
headknown <- 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
$
		CreateProcessRunner -> CreateProcess -> IO ()
withQuietOutput CreateProcessRunner
createProcessSuccess (CreateProcess -> IO ()) -> CreateProcess -> IO ()
forall a b. (a -> b) -> a -> b
$
			FilePath -> [FilePath] -> CreateProcess
proc FilePath
"git" [FilePath
"log", FilePath
headrev]
	if (Maybe ()
headknown Maybe () -> Maybe () -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ()
forall a. Maybe a
Nothing)
		then FilePath -> IO ()
updateUpstreamMaster FilePath
headrev
		else do
			FilePath
theirhead <- FilePath -> IO FilePath
getCurrentGitSha1 (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
getCurrentBranchRef
			Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
theirhead FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
headrev) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
				Bool
merged <- Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> IO FilePath -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
					FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"log", FilePath
headrev FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..HEAD", FilePath
"--ancestry-path"]
				Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
merged (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
					Bool -> IO ()
warnoutofdate Bool
True
  where
	gitbundleavail :: IO Bool
gitbundleavail = FilePath -> IO Bool
doesFileExist FilePath
disthead
	dotpropellorpopulated :: IO Bool
dotpropellorpopulated = do
		FilePath
d <- IO FilePath
dotPropellor
		FilePath -> IO Bool
doesFileExist (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"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 :: FilePath -> IO ()
updateUpstreamMaster FilePath
newref = do
	FilePath -> IO ()
changeWorkingDirectory (FilePath -> IO ()) -> IO FilePath -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
dotPropellor
	Maybe FilePath -> IO ()
go (Maybe FilePath -> IO ()) -> IO (Maybe FilePath) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe FilePath)
getoldref
  where
	go :: Maybe FilePath -> IO ()
go Maybe FilePath
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	go (Just FilePath
oldref) = do
		let tmprepo :: FilePath
tmprepo = FilePath
".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
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
tmprepo
		IO ()
cleantmprepo
		[FilePath] -> IO ()
git [FilePath
"clone", FilePath
"--quiet", FilePath
".", FilePath
tmprepo]

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

		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
$ FilePath -> IO Bool
fetchUpstreamBranch FilePath
tmprepo
		IO ()
cleantmprepo
		Bool -> IO ()
warnoutofdate Bool
True

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

	-- Get ref that the upstreambranch points to, only when
	-- the distrepo is being used.
	getoldref :: IO (Maybe FilePath)
getoldref = do
		Maybe FilePath
mref <- IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
			(FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"show-ref", FilePath
upstreambranch, FilePath
"--hash"]
		case Maybe FilePath
mref of
			Just FilePath
_ -> 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 FilePath), IO (Maybe FilePath))
-> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
hasRemote FilePath
"upstream")
					( do
						Maybe FilePath
v <- FilePath -> IO (Maybe FilePath)
remoteUrl FilePath
"upstream"
						Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case Maybe FilePath
v of
							Just FilePath
rurl | FilePath
rurl FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
distrepo -> Maybe FilePath
mref
							Maybe FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing
					, Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mref
					)
			Maybe FilePath
Nothing -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mref

warnoutofdate :: Bool -> IO ()
warnoutofdate :: Bool -> IO ()
warnoutofdate Bool
havebranch = FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
	[ FilePath
"** Your ~/.propellor/ is out of date.."
	, FilePath -> FilePath
indent FilePath
"A newer upstream version is available in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
distrepo
	, FilePath -> FilePath
indent (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ if Bool
havebranch
		then FilePath
"To merge it, run: git merge " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
upstreambranch
		else FilePath
"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/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
upstreambranch FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to it. Then run propellor again."
	]
  where
	indent :: FilePath -> FilePath
indent FilePath
s = FilePath
"   " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s