module Propellor.Bootstrap (
	bootstrapPropellorCommand,
	checkBinaryCommand,
	installGitCommand,
	buildPropellor,
) where

import Propellor.Base
import Propellor.Types.Info
import Propellor.Git.Config

import System.Posix.Files
import Data.List

type ShellCommand = String

-- Shell command line to ensure propellor is bootstrapped and ready to run.
-- Should be run inside the propellor config dir, and will install
-- all necessary build dependencies and build propellor.
bootstrapPropellorCommand :: Maybe System -> ShellCommand
bootstrapPropellorCommand msys = checkDepsCommand msys ++
	"&& if ! test -x ./propellor; then "
		++ buildCommand ++
	"; fi;" ++ checkBinaryCommand

-- Use propellor --check to detect if the local propellor binary has
-- stopped working (eg due to library changes), and must be rebuilt.
checkBinaryCommand :: ShellCommand
checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi"
  where
	go = intercalate " && "
		[ "cabal clean"
		, buildCommand
		]

buildCommand :: ShellCommand
buildCommand = intercalate " && "
	[ "cabal configure"
	, "cabal build propellor-config"
	, "ln -sf dist/build/propellor-config/propellor-config propellor"
	]

-- Run cabal configure to check if all dependencies are installed;
-- if not, run the depsCommand.
checkDepsCommand :: Maybe System -> ShellCommand
checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi"

-- Install build dependencies of propellor.
--
-- First, try to install ghc, cabal, gnupg, and all haskell libraries that
-- propellor uses from OS packages.
--
-- Some packages may not be available in some versions of Debian
-- (eg, Debian wheezy lacks async), or propellor may need a newer version.
-- So, as a second step, cabal is used to install all dependencies.
--
-- Note: May succeed and leave some deps not installed.
depsCommand :: Maybe System -> ShellCommand
depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true"
  where
	osinstall = case msys of
		Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
		Just (System (Debian _ _) _) -> useapt
		Just (System (Buntish _) _) -> useapt
		-- assume a debian derived system when not specified
		Nothing -> useapt

	useapt = "apt-get update" : map aptinstall debdeps

	cabalinstall =
		[ "cabal update"
		, "cabal install --only-dependencies"
		]

	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p

	-- This is the same deps listed in debian/control.
	debdeps =
		[ "gnupg"
		, "ghc"
		, "cabal-install"
		, "libghc-async-dev"
		, "libghc-missingh-dev"
		, "libghc-hslogger-dev"
		, "libghc-unix-compat-dev"
		, "libghc-ansi-terminal-dev"
		, "libghc-ifelse-dev"
		, "libghc-network-dev"
		, "libghc-mtl-dev"
		, "libghc-transformers-dev"
		, "libghc-exceptions-dev"
		, "libghc-stm-dev"
		, "libghc-text-dev"
		, "make"
		]
	fbsddeps =
		[ "gnupg"
		, "ghc"
		, "hs-cabal-install"
		, "hs-async"
		, "hs-MissingH"
		, "hs-hslogger"
		, "hs-unix-compat"
		, "hs-ansi-terminal"
		, "hs-IfElse"
		, "hs-network"
		, "hs-mtl"
		, "hs-transformers-base"
		, "hs-exceptions"
		, "hs-stm"
		, "hs-text"
		, "gmake"
		]

installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
	(Just (System (Debian _ _) _)) -> use apt
	(Just (System (Buntish _) _)) -> use apt
	(Just (System (FreeBSD _) _)) -> use
		[ "ASSUME_ALWAYS_YES=yes pkg update"
		, "ASSUME_ALWAYS_YES=yes pkg install git"
		]
	-- assume a debian derived system when not specified
	Nothing -> use apt
  where
	use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
	apt =
		[ "apt-get update"
		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
		]

buildPropellor :: Maybe Host -> IO ()
buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
	errorMessage "Propellor build failed!"
  where
	msys = case fmap (fromInfo . hostInfo) mh of
		Just (InfoVal sys) -> Just sys
		_ -> Nothing

-- Build propellor using cabal or stack, and symlink propellor to the
-- built binary.
build :: Maybe System -> IO Bool
build msys = catchBoolIO $ do
	bs <- getGitConfigValue "propellor.buildsystem"
	case bs of
		Just "stack" -> stackBuild msys
		_ -> cabalBuild msys

-- For speed, only runs cabal configure when it's not been run before.
-- If the build fails cabal may need to have configure re-run.
--
-- If the cabal configure fails, and a System is provided, installs
-- dependencies and retries.
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys = do
	make "dist/setup-config" ["propellor.cabal"] cabal_configure
	unlessM cabal_build $
		unlessM (cabal_configure <&&> cabal_build) $
			error "cabal build failed"
	-- For safety against eg power loss in the middle of the build,
	-- make a copy of the binary, and move it into place atomically.
	-- This ensures that the propellor symlink only ever points at
	-- a binary that is fully built. Also, avoid ever removing
	-- or breaking the symlink.
	--
	-- Need cp -a to make build timestamp checking work.
	unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
		error "cp of binary failed"
	rename (tmpfor safetycopy) safetycopy
	symlinkPropellorBin safetycopy
	return True
  where
	cabalbuiltbin = "dist/build/propellor-config/propellor-config"
	safetycopy = cabalbuiltbin ++ ".built"
	cabal_configure = ifM (cabal ["configure"])
		( return True
		, case msys of
			Nothing -> return False
			Just sys ->
				boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
					<&&> cabal ["configure"]
		)
	cabal_build = cabal ["build", "propellor-config"]

stackBuild :: Maybe System -> IO Bool
stackBuild _msys = do
	createDirectoryIfMissing True builddest
	ifM (stack buildparams)
		( do
			symlinkPropellorBin (builddest </> "propellor-config")
			return True
		, return False
		)
  where
 	builddest = ".built"
	buildparams =
		[ "--local-bin-path", builddest
		, "build"
		, ":propellor-config" -- only build config program
		, "--copy-bins"
		]

-- Atomic symlink creation/update.
symlinkPropellorBin :: FilePath -> IO ()
symlinkPropellorBin bin = do
	createSymbolicLink bin (tmpfor dest)
	rename (tmpfor dest) dest
  where
	dest = "propellor"

tmpfor :: FilePath -> FilePath
tmpfor f = f ++ ".propellortmp"

make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make dest srcs builder = do
	dt <- getmtime dest
	st <- mapM getmtime srcs
	when (dt == Nothing || any (> dt) st) $
		unlessM builder $
			error $ "failed to make " ++ dest
  where
	getmtime = catchMaybeIO . getModificationTime

cabal :: [String] -> IO Bool
cabal = boolSystem "cabal" . map Param

stack :: [String] -> IO Bool
stack = boolSystem "stack" . map Param