    -- | 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 b :: Bootstrapper
    b = Desc -> InfoVal Bootstrapper -> Property (HasInfo + UnixLike)
    forall v. IsInfo v => Desc -> v -> Property (HasInfo + UnixLike)
    pureInfoProperty Desc
    desc (Bootstrapper -> InfoVal Bootstrapper
    forall v. v -> InfoVal v
    InfoVal Bootstrapper
    b)
      where
    	desc :: Desc
    desc = "propellor bootstrapped with " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ case Bootstrapper
    b of
    		Robustly Stack -> "stack"
    		Robustly Cabal -> "cabal"
    		OSOnly -> "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
    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 = Desc -> Propellor Result -> Property Linux
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc -> Propellor Result -> Property (MetaTypes metatypes)
    property "Propellor bootstrapped" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    		Maybe System
    system <- Propellor (Maybe System)
    getOS
    		-- gets Host value representing the chroot this is run in
    		Host
    chroothost <- Propellor Host
    forall r (m :: * -> *). MonadReader r m => m r
    ask
    		-- load privdata from outside the chroot, and filter
    		-- to only the privdata needed inside the chroot.
    		PrivMap
    privdata <- IO PrivMap -> Propellor PrivMap
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO PrivMap -> Propellor PrivMap)
    -> IO PrivMap -> Propellor PrivMap
    forall a b. (a -> b) -> a -> b
    $ Host -> PrivMap -> PrivMap
    filterPrivData Host
    chroothost
    			(PrivMap -> PrivMap) -> IO PrivMap -> IO PrivMap
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Desc -> IO PrivMap
    readPrivDataFile Desc
    privDataLocal
    		Bootstrapper
    bootstrapper <- Propellor Bootstrapper
    getBootstrapper
    		Propellor Bool -> Propellor Result
    assumeChange (Propellor Bool -> Propellor Result)
    -> Propellor Bool -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ (Desc -> Propellor Bool) -> Propellor Bool
    forall a. (Desc -> Propellor a) -> Propellor a
    exposeTrueLocaldir ((Desc -> Propellor Bool) -> Propellor Bool)
    -> (Desc -> Propellor Bool) -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ Propellor Bool -> Desc -> Propellor Bool
    forall a b. a -> b -> a
    const (Propellor Bool -> Desc -> Propellor Bool)
    -> Propellor Bool -> Desc -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ do
    			IO () -> Propellor ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Desc -> IO ()
    createDirectoryIfMissing Bool
    True (Desc -> IO ()) -> Desc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				Desc -> Desc
    takeDirectory Desc
    privDataLocal
    			IO () -> Propellor ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ Desc -> Desc -> IO ()
    writeFileProtected Desc
    privDataLocal (Desc -> IO ()) -> Desc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				PrivMap -> Desc
    forall a. Show a => a -> Desc
    show PrivMap
    privdata
    			Desc -> Propellor Bool
    runShellCommand (Desc -> Propellor Bool) -> Desc -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [Desc] -> Desc
    buildShellCommand
    				[ "cd " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    localdir
    				, Bootstrapper -> Maybe System -> Desc
    checkDepsCommand Bootstrapper
    bootstrapper Maybe System
    system
    				, Bootstrapper -> Desc
    buildCommand Bootstrapper
    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
    reposource = case RepoSource
    reposource of
    	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
    	_ -> Property Linux
    go
      where
    	go :: Property Linux
    	go :: Property Linux
    go = Desc -> Propellor Result -> Property Linux
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc -> Propellor Result -> Property (MetaTypes metatypes)
    property ("Propellor repo cloned from " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    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 :: Desc
    tmpclone = Desc
    localdir Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ ".tmpclone"
    		Maybe System
    system <- Propellor (Maybe System)
    getOS
    		Propellor Bool -> Propellor Result
    assumeChange (Propellor Bool -> Propellor Result)
    -> Propellor Bool -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ (Desc -> Propellor Bool) -> Propellor Bool
    forall a. (Desc -> Propellor a) -> Propellor a
    exposeTrueLocaldir ((Desc -> Propellor Bool) -> Propellor Bool)
    -> (Desc -> Propellor Bool) -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ \sysdir :: Desc
    sysdir -> do
    			let originloc :: Desc
    originloc = case RepoSource
    reposource of
    				GitRepoUrl s :: Desc
    s -> Desc
    s
    				GitRepoOutsideChroot -> Desc
    sysdir
    			Desc -> Propellor Bool
    runShellCommand (Desc -> Propellor Bool) -> Desc -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [Desc] -> Desc
    buildShellCommand
    				[ Maybe System -> Desc
    installGitCommand Maybe System
    system
    				, "rm -rf " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    tmpclone
    				, "git clone " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc -> Desc
    shellEscape Desc
    originloc Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ " " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    tmpclone
    				, "mkdir -p " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    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.
    				, "(cd " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    tmpclone Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ " && tar c .) | (cd " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    localdir Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ " && tar x)"
    				, "rm -rf " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    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
    $ (Desc -> Propellor Bool) -> Propellor Bool
    forall a. (Desc -> Propellor a) -> Propellor a
    exposeTrueLocaldir ((Desc -> Propellor Bool) -> Propellor Bool)
    -> (Desc -> Propellor Bool) -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ Propellor Bool -> Desc -> Propellor Bool
    forall a b. a -> b -> a
    const (Propellor Bool -> Desc -> Propellor Bool)
    -> Propellor Bool -> Desc -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $
    		Desc -> Propellor Bool
    runShellCommand (Desc -> Propellor Bool) -> Desc -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ [Desc] -> Desc
    buildShellCommand
    			[ "cd " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    localdir
    			, "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 = Desc -> Propellor Result -> Property Linux
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc -> Propellor Result -> Property (MetaTypes metatypes)
    property ("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 :: Desc
    gitconfig = Desc
    localdir Desc -> Desc -> Desc
    </> ".git" Desc -> Desc -> Desc
    </> "config"
    		ByteString
    cfg <- IO ByteString -> Propellor ByteString
    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
    $ Desc -> IO ByteString
    B.readFile Desc
    gitconfig
    		(Desc -> Propellor ()) -> Propellor ()
    forall a. (Desc -> Propellor a) -> Propellor a
    exposeTrueLocaldir ((Desc -> Propellor ()) -> Propellor ())
    -> (Desc -> Propellor ()) -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ Propellor () -> Desc -> Propellor ()
    forall a b. a -> b -> a
    const (Propellor () -> Desc -> Propellor ())
    -> Propellor () -> Desc -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $
    			IO () -> Propellor ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ Desc -> ByteString -> IO ()
    B.writeFile Desc
    gitconfig ByteString
    cfg
    		Result -> Propellor Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    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 (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
    <$> Desc -> IO Bool
    doesDirectoryExist Desc
    localdir))

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

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

    assumeChange :: Propellor Bool -> Propellor Result
    assumeChange :: Propellor Bool -> Propellor Result
    assumeChange a :: Propellor Bool
    a = do
    	Bool
    ok <- Propellor Bool
    a
    	Result -> Propellor Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Result
    cmdResult Bool
    ok Result -> Result -> Result
    forall a. Semigroup a => a -> a -> a
    <> Result
    MadeChange)

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

    runShellCommand :: String -> Propellor Bool
    runShellCommand :: Desc -> Propellor Bool
    runShellCommand s :: Desc
    s = IO Bool -> Propellor Bool
    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
    $ Desc -> [CommandParam] -> IO Bool
    boolSystem "sh" [ Desc -> CommandParam
    Param "-c", Desc -> CommandParam
    Param Desc
    s]