module Propellor.Git.VerifiedBranch where

import Propellor.Base
import Propellor.Git
import Propellor.PrivData.Paths

{- To verify origin branch commit's signature, have to convince gpg
 - to use our keyring while running git verify-tag.
 - Which has no way to pass options to gpg. Argh!
 -}
verifyOriginBranch :: String -> IO Bool
verifyOriginBranch :: String -> IO Bool
verifyOriginBranch String
originbranch = do
	let gpgconf :: String
gpgconf = String
privDataDir String -> String -> String
</> String
"gpg.conf"
	String
keyring <- IO String
privDataKeyring
	String -> String -> IO ()
writeFile String
gpgconf forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
		[ String
" keyring " forall a. [a] -> [a] -> [a]
++ String
keyring
		, String
"no-auto-check-trustdb"
		]
	-- gpg is picky about perms
	String -> (FileMode -> FileMode) -> IO ()
modifyFileMode String
privDataDir ([FileMode] -> FileMode -> FileMode
removeModes [FileMode]
otherGroupModes)
	Bool
verified <- String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
boolSystemEnv String
"git" [String -> CommandParam
Param String
"verify-commit", String -> CommandParam
Param String
originbranch]
		(forall a. a -> Maybe a
Just [(String
"GNUPGHOME", String
privDataDir)])
	String -> IO ()
nukeFile forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"trustdb.gpg"
	String -> IO ()
nukeFile forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"pubring.gpg"
	String -> IO ()
nukeFile forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"gpg.conf"
	forall (m :: * -> *) a. Monad m => a -> m a
return Bool
verified

-- Returns True if HEAD is changed by fetching and merging from origin.
fetchOrigin :: IO Bool
fetchOrigin :: IO Bool
fetchOrigin = do
	Bool
fetched <- forall (m :: * -> *) r.
(MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
String -> m r -> m r
actionMessage String
"Pull from central git repository" forall a b. (a -> b) -> a -> b
$
		String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"fetch"]
	if Bool
fetched
		then IO Bool
mergeOrigin
		else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

mergeOrigin :: IO Bool
mergeOrigin :: IO Bool
mergeOrigin = do
	String
branchref <- IO String
getCurrentBranch
	let originbranch :: String
originbranch = String
"origin" String -> String -> String
</> String
branchref

	String
oldsha <- String -> IO String
getCurrentGitSha1 String
branchref

	String
keyring <- IO String
privDataKeyring
	forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> IO Bool
doesFileExist String
keyring) forall a b. (a -> b) -> a -> b
$
		forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
verifyOriginBranch String
originbranch)
			( do
				String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"git branch " forall a. [a] -> [a] -> [a]
++ String
originbranch forall a. [a] -> [a] -> [a]
++ String
" gpg signature verified; merging"
				Handle -> IO ()
hFlush Handle
stdout
				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
"merge", String -> CommandParam
Param String
originbranch]
			, forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ String
"git branch " forall a. [a] -> [a] -> [a]
++ String
originbranch forall a. [a] -> [a] -> [a]
++ String
" is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
			)

	String
newsha <- String -> IO String
getCurrentGitSha1 String
branchref
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
oldsha forall a. Eq a => a -> a -> Bool
/= String
newsha