{-# LANGUAGE DeriveDataTypeable #-}

-- | Properties to manipulate propellor's @/usr/local/propellor@ on spun hosts

module Propellor.Property.Localdir where

import Propellor.Base
import Propellor.Git.Config
import Propellor.Types.Info
import Propellor.Types.Container
import Propellor.Property.Mount (partialBindMountsOf, umountLazy)
import qualified Propellor.Property.Git as Git

-- | Sets the url to use as the origin of propellor's git repository.
--
-- By default, the url is taken from the deploy or origin remote of
-- the repository that propellor --spin is run in. Setting this property
-- overrides that default behavior with a different url.
--
-- When hosts are being updated without using -- --spin, eg when using
-- the `Propellor.Property.Cron.runPropellor` cron job, this property can
-- be set to redirect them to a new git repository url.
hasOriginUrl :: String -> Property (HasInfo + DebianLike)
hasOriginUrl :: String -> Property (HasInfo + DebianLike)
hasOriginUrl String
u =
	forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property UnixLike
p (forall v. IsInfo v => v -> Info
toInfo (forall v. v -> InfoVal v
InfoVal (String -> OriginUrl
OriginUrl String
u)))
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Git.installed
  where
	p :: Property UnixLike
	p :: Property UnixLike
p = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
"propellor repo url " forall a. [a] -> [a] -> [a]
++ String
u) forall a b. (a -> b) -> a -> b
$ do
		Maybe String
curru <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe String)
getRepoUrl
		if Maybe String
curru forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
u
			then forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
			else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ String -> IO ()
setRepoUrl String
u

newtype OriginUrl = OriginUrl String
	deriving (Int -> OriginUrl -> ShowS
[OriginUrl] -> ShowS
OriginUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginUrl] -> ShowS
$cshowList :: [OriginUrl] -> ShowS
show :: OriginUrl -> String
$cshow :: OriginUrl -> String
showsPrec :: Int -> OriginUrl -> ShowS
$cshowsPrec :: Int -> OriginUrl -> ShowS
Show, Typeable)

-- | Removes the @/usr/local/propellor@ directory used to spin the host, after
-- ensuring other properties.  Without this property, that directory is left
-- behind after the spin.
--
-- Does not perform other clean up, such as removing Haskell libraries that were
-- installed in order to build propellor, or removing cronjobs such as created
-- by 'Propellor.Property.Cron.runPropellor'.
removed :: Property UnixLike
removed :: Property UnixLike
removed = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (String -> IO Bool
doesDirectoryExist String
localdir) forall a b. (a -> b) -> a -> b
$
	forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"propellor's /usr/local dir to be removed" forall a b. (a -> b) -> a -> b
$ do
		String -> (Result -> Propellor Result) -> Propellor ()
endAction String
"removing /usr/local/propellor" forall {p}. p -> Propellor Result
atend
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
  where
	atend :: p -> Propellor Result
atend p
_ = do
		forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
FilesystemContained)
			-- In a chroot, all we have to do is unmount localdir,
			-- and then delete it
			( forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
umountLazy String
localdir
			-- Outside of a chroot, if we don't unmount any bind
			-- mounts of localdir before deleting it, another run of
			-- propellor will have problems reestablishing those
			-- bind mounts in order to spin chroots
			, forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
partialBindMountsOf String
localdir
				forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
umountLazy
			)
		forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
localdir
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange