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
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"
distrepo :: FilePath
distrepo :: String
distrepo = String
distdir String -> String -> String
</> String
"propellor.git"
disthead :: FilePath
disthead :: String
disthead = String
distdir String -> String -> String
</> String
"head"
upstreambranch :: String
upstreambranch :: String
upstreambranch = String
"upstream/master"
netrepo :: String
netrepo :: String
netrepo = String
"https://git.joeyh.name/git/propellor.git"
dotPropellor :: IO FilePath
dotPropellor :: IO String
dotPropellor = do
String
home <- IO String
myHomeDir
forall (m :: * -> *) a. Monad m => a -> m a
return (String
home String -> String -> String
</> String
".propellor")
buildSystem :: IO String
buildSystem :: IO String
buildSystem = do
String
d <- IO String
Package.getLibDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if String
"stack-work" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
d then String
"stack" else String
"cabal"
interactiveInit :: IO ()
interactiveInit :: IO ()
interactiveInit = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesDirectoryExist forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor)
( forall a. HasCallStack => String -> a
error String
"~/.propellor/ already exists, not doing anything"
, do
IO ()
welcomeBanner
IO ()
setup
)
cabalSandboxRequired :: IO Bool
cabalSandboxRequired :: IO Bool
cabalSandboxRequired = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
cabal
( do
String
home <- IO String
myHomeDir
[String]
ls <- String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO []
(String -> IO String
readFile (String
home String -> String -> String
</> String
".cabal" String -> String -> String
</> String
"config"))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"True" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"require-sandbox:" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
ls
, forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
where
cabal :: IO Bool
cabal = IO String
buildSystem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
bSystem -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
bSystem forall a. Eq a => a -> a -> Bool
== String
"cabal")
say :: String -> IO ()
say :: String -> IO ()
say = forall v. Outputable v => v -> IO ()
outputConcurrent
sayLn :: String -> IO ()
sayLn :: String -> IO ()
sayLn String
s = String -> IO ()
say (String
s forall a. [a] -> [a] -> [a]
++ String
"\n")
welcomeBanner :: IO ()
welcomeBanner :: IO ()
welcomeBanner = String -> IO ()
say forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map (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 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 forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, IO ())]
cs) forall a. [a] -> [a] -> [a]
++ String
"] ")
IO ()
flushConcurrentOutput
Handle -> IO ()
hFlush Handle
stdout
String
r <- forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getLine
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r
then forall a b. (a, b) -> b
snd (forall a. [a] -> a
head [(String, IO ())]
cs)
else case forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
s, IO ()
_) -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s forall a. Eq a => a -> a -> Bool
== String
r) [(String, IO ())]
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", forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ 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", forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ 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 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
""
String
b <- IO String
buildSystem
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"git"
[ String -> CommandParam
Param String
"config"
, String -> CommandParam
Param String
"propellor.buildsystem"
, String -> CommandParam
Param String
b
]
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
cabalSandboxRequired
( forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"cabal"
[ String -> CommandParam
Param String
"sandbox"
, String -> CommandParam
Param String
"init"
]
, forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
Maybe Host -> IO ()
buildPropellor forall a. Maybe a
Nothing
String -> IO ()
sayLn String
""
String -> IO ()
sayLn String
"Great! Propellor is bootstrapped."
IO ()
section
String -> IO ()
sayLn String
"Propellor can use gpg to encrypt private data about the systems it manages,"
String -> IO ()
sayLn String
"and to sign git commits."
String
gpg <- IO String
getGpgBin
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
inPath String
gpg)
( IO ()
setupGpgKey
, do
String -> IO ()
sayLn String
"You don't seem to have gpg installed, so skipping setting it up."
IO ()
explainManualSetupGpgKey
)
IO ()
section
String -> IO ()
sayLn String
"Everything is set up ..."
String -> IO ()
sayLn String
"Your next step is to edit ~/.propellor/config.hs"
String -> IO ()
sayLn String
"and run propellor again to try it out."
String -> IO ()
sayLn String
""
String -> IO ()
sayLn String
"For docs, see https://propellor.branchable.com/"
String -> IO ()
sayLn String
"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
[(String, String)]
ks <- IO [(String, String)]
listSecretKeys
String -> IO ()
sayLn String
""
case [(String, String)]
ks of
[] -> IO ()
makeGpgKey
[(String
k, String
d)] -> do
String -> IO ()
sayLn forall a b. (a -> b) -> a -> b
$ String
"You have one gpg key: " 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 forall a b. (a -> b) -> a -> b
$ String
"Skipping gpg setup. If you change your mind, run: propellor --add-key " forall a. [a] -> [a] -> [a]
++ String
k)
]
[(String, String)]
_ -> do
let nks :: [((String, String), String)]
nks = forall a b. [a] -> [b] -> [(a, b)]
zip [(String, String)]
ks (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show ([Integer
1..] :: [Integer]))
String -> IO ()
sayLn String
"I see you have several gpg keys:"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((String, String), String)]
nks forall a b. (a -> b) -> a -> b
$ \((String
k, String
d), String
n) ->
String -> IO ()
sayLn forall a b. (a -> b) -> a -> b
$ String
" " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ 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?"
(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 forall a. [a] -> [a] -> [a]
++ String
" (keyid " forall a. [a] -> [a] -> [a]
++ String
k 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 ..."
String
gpg <- IO String
getGpgBin
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
gpg [String -> CommandParam
Param String
"--gen-key"]
[(String, String)]
ks <- IO [(String, String)]
listSecretKeys
case [(String, String)]
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 forall a b. (a -> b) -> a -> b
$ String
"Telling propellor to use your gpg key by running: propellor --add-key " forall a. [a] -> [a] -> [a]
++ String
keyid
String
d <- IO String
dotPropellor
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (String -> [CommandParam] -> IO Bool
boolSystem (String
d String -> String -> String
</> String
"propellor") [String -> CommandParam
Param String
"--add-key", String -> CommandParam
Param String
keyid]) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
sayLn String
"Oops, that didn't work! You can retry the same command later."
String -> IO ()
sayLn String
"Continuing onward ..."
minimalConfig :: IO Result
minimalConfig :: IO Result
minimalConfig = do
String
d <- IO String
dotPropellor
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
d
String -> IO ()
changeWorkingDirectory String
d
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"init"]
String -> [String] -> IO ()
addfile String
"config.cabal" [String]
cabalcontent
String -> [String] -> IO ()
addfile String
"config.hs" [String]
configcontent
String -> [String] -> IO ()
addfile String
"stack.yaml" [String]
stackcontent
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
where
addfile :: String -> [String] -> IO ()
addfile String
f [String]
content = do
String -> String -> IO ()
writeFile String
f ([String] -> String
unlines [String]
content)
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 =
[ String
"resolver: " forall a. [a] -> [a] -> [a]
++ String
stackResolver
, String
"packages:"
, String
"- '.'"
, String
"extra-deps:"
, String
"- propellor-" 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
String
d <- IO String
dotPropellor
let enterdotpropellor :: IO Bool
enterdotpropellor = String -> IO ()
changeWorkingDirectory String
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
ok <- forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesFileExist String
distrepo forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> String -> IO Bool
doesDirectoryExist String
distrepo)
( forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM forall a. a -> a
id
[ String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"clone", String -> CommandParam
File String
distrepo, String -> CommandParam
File String
d]
, String -> IO Bool
fetchUpstreamBranch String
distrepo
, IO Bool
enterdotpropellor
, String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"remote", String -> CommandParam
Param String
"rm", String -> CommandParam
Param String
"origin"]
]
, forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM forall a. a -> a
id
[ String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"clone", String -> CommandParam
Param String
netrepo, String -> CommandParam
File String
d]
, IO Bool
enterdotpropellor
, String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"remote", String -> CommandParam
Param String
"rename", String -> CommandParam
Param String
"origin", String -> CommandParam
Param String
"upstream"]
, String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"config", String -> CommandParam
Param String
"--unset", String -> CommandParam
Param String
"branch.master.remote", String -> CommandParam
Param String
"upstream"]
]
)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. ToResult t => t -> Result
toResult Bool
ok)
fetchUpstreamBranch :: FilePath -> IO Bool
fetchUpstreamBranch :: String -> IO Bool
fetchUpstreamBranch String
repo = do
String -> IO ()
changeWorkingDirectory 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/" forall a. [a] -> [a] -> [a]
++ String
upstreambranch)
, String -> CommandParam
Param String
"--quiet"
]
checkRepoUpToDate :: IO ()
checkRepoUpToDate :: IO ()
checkRepoUpToDate = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (IO Bool
gitbundleavail forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> IO Bool
dotpropellorpopulated) forall a b. (a -> b) -> a -> b
$ do
String
headrev <- forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
disthead
String -> IO ()
changeWorkingDirectory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor
Maybe ()
headknown <- forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$
CreateProcessRunner -> CreateProcess -> IO ()
withQuietOutput CreateProcessRunner
createProcessSuccess forall a b. (a -> b) -> a -> b
$
String -> [String] -> CreateProcess
proc String
"git" [String
"log", String
headrev]
if (Maybe ()
headknown forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing)
then String -> IO ()
updateUpstreamMaster String
headrev
else do
String
theirhead <- String -> IO String
getCurrentGitSha1 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getCurrentBranchRef
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
theirhead forall a. Eq a => a -> a -> Bool
/= String
headrev) forall a b. (a -> b) -> a -> b
$ do
Bool
merged <- Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> [String] -> IO String
readProcess String
"git" [String
"log", String
headrev forall a. [a] -> [a] -> [a]
++ String
"..HEAD", String
"--ancestry-path"]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
merged forall a b. (a -> b) -> a -> b
$
Bool -> IO ()
warnoutofdate Bool
True
where
gitbundleavail :: IO Bool
gitbundleavail = String -> IO Bool
doesFileExist String
disthead
dotpropellorpopulated :: IO Bool
dotpropellorpopulated = do
String
d <- IO String
dotPropellor
String -> IO Bool
doesFileExist (String
d String -> String -> String
</> String
"propellor.cabal")
updateUpstreamMaster :: String -> IO ()
updateUpstreamMaster :: String -> IO ()
updateUpstreamMaster String
newref = do
String -> IO ()
changeWorkingDirectory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor
Maybe String -> IO ()
go 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 = 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO 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"]
Version
v <- IO Version
gitVersion
let mergeparams :: [String]
mergeparams =
[ String
"merge", String
newref
, String
"-s", String
"recursive"
, String
"-Xtheirs"
, String
"--quiet"
, String
"-m", String
"merging upstream version"
] forall a. [a] -> [a] -> [a]
++ if Version
v forall a. Ord a => a -> a -> Bool
>= [Int
2,Int
9]
then [ String
"--allow-unrelated-histories" ]
else []
[String] -> IO ()
git [String]
mergeparams
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> IO Bool
fetchUpstreamBranch String
tmprepo
IO ()
cleantmprepo
Bool -> IO ()
warnoutofdate Bool
True
git :: [String] -> IO ()
git = String -> [String] -> IO ()
run String
"git"
run :: String -> [String] -> IO ()
run String
cmd [String]
ps = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (String -> [CommandParam] -> IO Bool
boolSystem String
cmd (forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param [String]
ps)) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to run " forall a. [a] -> [a] -> [a]
++ String
cmd forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
ps
getoldref :: IO (Maybe String)
getoldref = do
Maybe String
mref <- forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
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 Maybe String
mref of
Just String
_ -> do
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
hasRemote String
"upstream")
( do
Maybe String
v <- String -> IO (Maybe String)
remoteUrl String
"upstream"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe String
v of
Just String
rurl | String
rurl forall a. Eq a => a -> a -> Bool
== String
distrepo -> Maybe String
mref
Maybe String
_ -> forall a. Maybe a
Nothing
, forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mref
)
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mref
warnoutofdate :: Bool -> IO ()
warnoutofdate :: Bool -> IO ()
warnoutofdate Bool
havebranch = forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage 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 " forall a. [a] -> [a] -> [a]
++ String
distrepo
, String -> String
indent forall a b. (a -> b) -> a -> b
$ if Bool
havebranch
then String
"To merge it, run: git merge " 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/" forall a. [a] -> [a] -> [a]
++ String
upstreambranch forall a. [a] -> [a] -> [a]
++ String
" to it. Then run propellor again."
]
where
indent :: String -> String
indent String
s = String
" " forall a. [a] -> [a] -> [a]
++ String
s