{-# 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 =
	Property UnixLike
-> Info
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property UnixLike
p (InfoVal OriginUrl -> Info
forall v. IsInfo v => v -> Info
toInfo (OriginUrl -> InfoVal OriginUrl
forall v. v -> InfoVal v
InfoVal (String -> OriginUrl
OriginUrl String
u)))
		Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Git.installed
  where
	p :: Property UnixLike
	p :: Property UnixLike
p = String -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
"propellor repo url " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
		Maybe String
curru <- IO (Maybe String) -> Propellor (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe String)
getRepoUrl
		if Maybe String
curru Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
u
			then Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
			else IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ String -> IO ()
setRepoUrl String
u

newtype OriginUrl = OriginUrl String
	deriving (Int -> OriginUrl -> String -> String
[OriginUrl] -> String -> String
OriginUrl -> String
(Int -> OriginUrl -> String -> String)
-> (OriginUrl -> String)
-> ([OriginUrl] -> String -> String)
-> Show OriginUrl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OriginUrl] -> String -> String
$cshowList :: [OriginUrl] -> String -> String
show :: OriginUrl -> String
$cshow :: OriginUrl -> String
showsPrec :: Int -> OriginUrl -> String -> String
$cshowsPrec :: Int -> OriginUrl -> String -> String
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 = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (String -> IO Bool
doesDirectoryExist String
localdir) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
	String -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"propellor's /usr/local dir to be removed" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
		String -> (Result -> Propellor Result) -> Propellor ()
endAction String
"removing /usr/local/propellor" Result -> Propellor Result
forall p. p -> Propellor Result
atend
		Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
  where
	atend :: p -> Propellor Result
atend p
_ = do
		Propellor Bool -> (Propellor (), Propellor ()) -> Propellor ()
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
			( IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
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
			, IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
partialBindMountsOf String
localdir
				IO [String] -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
umountLazy
			)
		IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
localdir
		Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange