    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 originbranch :: String
    originbranch = do
    	let gpgconf :: String
    gpgconf = String
    privDataDir String -> String -> String
    </> "gpg.conf"
    	String
    keyring <- IO String
    privDataKeyring
    	String -> String -> IO ()
    writeFile String
    gpgconf (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
    		[ " keyring " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    keyring
    		, "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 "git" [String -> CommandParam
    Param "verify-commit", String -> CommandParam
    Param String
    originbranch]
    		([(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just [("GNUPGHOME", String
    privDataDir)])
    	String -> IO ()
    nukeFile (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    privDataDir String -> String -> String
    </> "trustdb.gpg"
    	String -> IO ()
    nukeFile (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    privDataDir String -> String -> String
    </> "pubring.gpg"
    	String -> IO ()
    nukeFile (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    privDataDir String -> String -> String
    </> "gpg.conf"
    	Bool -> IO Bool
    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 <- String -> IO Bool -> IO Bool
    forall (m :: * -> *) r.
    (MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
    String -> m r -> m r
    actionMessage "Pull from central git repository" (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    		String -> [CommandParam] -> IO Bool
    boolSystem "git" [String -> CommandParam
    Param "fetch"]
    	if Bool
    fetched
    		then IO Bool
    mergeOrigin
    		else Bool -> IO Bool
    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 = "origin" String -> String -> String
    </> String
    branchref

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

    	String
    keyring <- IO String
    privDataKeyring
    	IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (String -> IO Bool
    doesFileExist String
    keyring) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    		IO Bool -> (IO (), IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (String -> IO Bool
    verifyOriginBranch String
    originbranch)
    			( do
    				String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "git branch " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    originbranch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " gpg signature verified; merging"
    				Handle -> IO ()
    hFlush Handle
    stdout
    				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 "git" [String -> CommandParam
    Param "merge", String -> CommandParam
    Param String
    originbranch]
    			, String -> IO ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    warningMessage (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "git branch " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    originbranch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " 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
    	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
    $ String
    oldsha String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    newsha