    -- | This module contains properties that configure how Propellor
    -- bootstraps to run itself on a Host.

    module Propellor.Property.Bootstrap (
    	Bootstrapper(..),
    	Builder(..),
    	bootstrapWith,
    	RepoSource(..),
    	bootstrappedFrom,
    	clonedFrom
    ) where

    import Propellor.Base
    import Propellor.Bootstrap
    import Propellor.Types.Info
    import Propellor.Types.Container
    import Propellor.Property.Chroot
    import Propellor.PrivData.Paths

    import Data.List
    import qualified Data.ByteString as B

    -- | This property can be used to configure the `Bootstrapper` that is used
    -- to bootstrap propellor on a Host. For example, if you want to use
    -- stack:
    --
    -- > host "example.com" $ props
    -- > 	& bootstrapWith (Robustly Stack)
    --
    -- When `bootstrappedFrom` is used in a `Chroot` or other `Container`,
    -- this property can also be added to the chroot to configure it.
    bootstrapWith :: Bootstrapper -> Property (HasInfo + UnixLike)
    bootstrapWith :: Bootstrapper -> Property (HasInfo + UnixLike)
    bootstrapWith Bootstrapper
    b = [Char] -> InfoVal Bootstrapper -> Property (HasInfo + UnixLike)
    forall v. IsInfo v => [Char] -> v -> Property (HasInfo + UnixLike)
    pureInfoProperty [Char]
    desc (Bootstrapper -> InfoVal Bootstrapper
    forall v. v -> InfoVal v
    InfoVal Bootstrapper
    b)
      where
    	desc :: [Char]
    desc = [Char]
    "propellor bootstrapped with " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ case Bootstrapper
    b of
    		Robustly Builder
    Stack -> [Char]
    "stack"
    		Robustly Builder
    Cabal -> [Char]
    "cabal"
    		Bootstrapper
    OSOnly -> [Char]
    "OS packages only"

    -- | Where a propellor repository should be bootstrapped from.
    data RepoSource
    	= GitRepoUrl String
    	| GitRepoOutsideChroot
    	-- ^ When used in a chroot, this copies the git repository from
    	-- outside the chroot, including its configuration.

    -- | Bootstraps a propellor installation into
    -- /usr/local/propellor/
    --
    -- Normally, propellor is bootstrapped by eg, using propellor --spin,
    -- and so this property is not generally needed.
    --
    -- This property only does anything when used inside a Chroot or other
    -- Container. This is particularly useful inside a chroot used to build a
    -- disk image, to make the disk image have propellor installed.
    --
    -- The git repository is cloned (or pulled to update if it already exists).
    --
    -- All build dependencies are installed, using distribution packages
    -- or falling back to using cabal or stack.
    bootstrappedFrom :: RepoSource -> Property Linux
    bootstrappedFrom :: RepoSource -> Property Linux
    bootstrappedFrom RepoSource
    reposource = Propellor Bool -> Property Linux -> Property Linux
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (ContainerCapability -> Propellor Bool
    hasContainerCapability ContainerCapability
    FilesystemContained) (Property Linux -> Property Linux)
    -> Property Linux -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    	Property Linux
    go Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` RepoSource -> Property Linux
    clonedFrom RepoSource
    reposource
      where
    	go :: Property Linux
    	go :: Property Linux
    go = [Char] -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    [Char] -> Propellor Result -> Property (MetaTypes metatypes)
    property [Char]
    "Propellor bootstrapped" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    		system <- Propellor (Maybe System)
    getOS
    		-- gets Host value representing the chroot this is run in
    		chroothost <- ask
    		-- load privdata from outside the chroot, and filter
    		-- to only the privdata needed inside the chroot.
    		privdata <- liftIO $ filterPrivData chroothost
    			<$> readPrivDataFile privDataLocal
    		bootstrapper <- getBootstrapper
    		assumeChange $ exposeTrueLocaldir $ const $ do
    			liftIO $ createDirectoryIfMissing True $
    				takeDirectory privDataLocal
    			liftIO $ writeFileProtected privDataLocal $
    				show privdata
    			runShellCommand $ buildShellCommand
    				[ "cd " ++ localdir
    				, checkDepsCommand bootstrapper system
    				, buildCommand bootstrapper
    				]

    -- | Clones the propellor repository into /usr/local/propellor/
    --
    -- If the propellor repo has already been cloned, pulls to get it
    -- up-to-date.
    clonedFrom :: RepoSource -> Property Linux
    clonedFrom :: RepoSource -> Property Linux
    clonedFrom RepoSource
    reposource = case RepoSource
    reposource of
    	RepoSource
    GitRepoOutsideChroot -> Property Linux
    go Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` Property Linux
    copygitconfig
    	RepoSource
    _ -> Property Linux
    go
      where
    	go :: Property Linux
    	go :: Property Linux
    go = [Char] -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    [Char] -> Propellor Result -> Property (MetaTypes metatypes)
    property ([Char]
    "Propellor repo cloned from " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    sourcedesc) (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		Propellor Bool
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM Propellor Bool
    needclone (Propellor Result
    makeclone, Propellor Result
    updateclone)

    	makeclone :: Propellor Result
    makeclone = do
    		let tmpclone :: [Char]
    tmpclone = [Char]
    localdir [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ".tmpclone"
    		system <- Propellor (Maybe System)
    getOS
    		assumeChange $ exposeTrueLocaldir $ \[Char]
    sysdir -> do
    			let originloc :: [Char]
    originloc = case RepoSource
    reposource of
    				GitRepoUrl [Char]
    s -> [Char]
    s
    				RepoSource
    GitRepoOutsideChroot -> [Char]
    sysdir
    			[Char] -> Propellor Bool
    runShellCommand ([Char] -> Propellor Bool) -> [Char] -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    buildShellCommand
    				[ Maybe System -> [Char]
    installGitCommand Maybe System
    system
    				, [Char]
    "rm -rf " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    tmpclone
    				, [Char]
    "git clone " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    shellEscape [Char]
    originloc [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    tmpclone
    				, [Char]
    "mkdir -p " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    localdir
    				-- This is done rather than deleting
    				-- the old localdir, because if it is bound
    				-- mounted from outside the chroot, deleting
    				-- it after unmounting in unshare will remove
    				-- the bind mount outside the unshare.
    				, [Char]
    "(cd " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    tmpclone [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " && tar c .) | (cd " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    localdir [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " && tar x)"
    				, [Char]
    "rm -rf " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    tmpclone
    				]

    	updateclone :: Propellor Result
    updateclone = Propellor Bool -> Propellor Result
    assumeChange (Propellor Bool -> Propellor Result)
    -> Propellor Bool -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Propellor Bool) -> Propellor Bool
    forall a. ([Char] -> Propellor a) -> Propellor a
    exposeTrueLocaldir (([Char] -> Propellor Bool) -> Propellor Bool)
    -> ([Char] -> Propellor Bool) -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ Propellor Bool -> [Char] -> Propellor Bool
    forall a b. a -> b -> a
    const (Propellor Bool -> [Char] -> Propellor Bool)
    -> Propellor Bool -> [Char] -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $
    		[Char] -> Propellor Bool
    runShellCommand ([Char] -> Propellor Bool) -> [Char] -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    buildShellCommand
    			[ [Char]
    "cd " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    localdir
    			, [Char]
    "git pull"
    			]

    	-- Copy the git config of the repo outside the chroot into the
    	-- chroot. This way it has the same remote urls, and other git
    	-- configuration.
    	copygitconfig :: Property Linux
    	copygitconfig :: Property Linux
    copygitconfig = [Char] -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    [Char] -> Propellor Result -> Property (MetaTypes metatypes)
    property ([Char]
    "Propellor repo git config copied from outside the chroot") (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    		let gitconfig :: [Char]
    gitconfig = [Char]
    localdir [Char] -> [Char] -> [Char]
    </> [Char]
    ".git" [Char] -> [Char] -> [Char]
    </> [Char]
    "config"
    		cfg <- IO ByteString -> Propellor ByteString
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> Propellor ByteString)
    -> IO ByteString -> Propellor ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ByteString
    B.readFile [Char]
    gitconfig
    		exposeTrueLocaldir $ const $
    			liftIO $ B.writeFile gitconfig cfg
    		return MadeChange

    	needclone :: Propellor Bool
    needclone = (ContainerCapability -> Propellor Bool
    hasContainerCapability ContainerCapability
    FilesystemContained Propellor Bool -> Propellor Bool -> Propellor Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <&&> Propellor Bool
    truelocaldirisempty)
    		Propellor Bool -> Propellor Bool -> Propellor Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <||> (IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO Bool
    doesDirectoryExist [Char]
    localdir))

    	truelocaldirisempty :: Propellor Bool
    truelocaldirisempty = ([Char] -> Propellor Bool) -> Propellor Bool
    forall a. ([Char] -> Propellor a) -> Propellor a
    exposeTrueLocaldir (([Char] -> Propellor Bool) -> Propellor Bool)
    -> ([Char] -> Propellor Bool) -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ Propellor Bool -> [Char] -> Propellor Bool
    forall a b. a -> b -> a
    const (Propellor Bool -> [Char] -> Propellor Bool)
    -> Propellor Bool -> [Char] -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $
    		[Char] -> Propellor Bool
    runShellCommand ([Char]
    "test ! -d " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    localdir [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/.git")

    	sourcedesc :: [Char]
    sourcedesc = case RepoSource
    reposource of
    		GitRepoUrl [Char]
    s -> [Char]
    s
    		RepoSource
    GitRepoOutsideChroot -> [Char]
    localdir [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " outside the chroot"

    assumeChange :: Propellor Bool -> Propellor Result
    assumeChange :: Propellor Bool -> Propellor Result
    assumeChange Propellor Bool
    a = do
    	ok <- Propellor Bool
    a
    	return (cmdResult ok <> MadeChange)

    buildShellCommand :: [String] -> String
    buildShellCommand :: [[Char]] -> [Char]
    buildShellCommand = [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "&&" ([[Char]] -> [Char])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[Char]
    c -> [Char]
    "(" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    c [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")")

    runShellCommand :: String -> Propellor Bool
    runShellCommand :: [Char] -> Propellor Bool
    runShellCommand [Char]
    s = IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [CommandParam] -> IO Bool
    boolSystem [Char]
    "sh" [ [Char] -> CommandParam
    Param [Char]
    "-c", [Char] -> CommandParam
    Param [Char]
    s]