module Propellor.Property.SiteSpecific.GitHome where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User

-- | Clones Joey Hess's git home directory, and runs its fixups script.
installedFor :: User -> Property DebianLike
installedFor :: User -> Property DebianLike
installedFor user :: User
user@(User UserName
u) = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> IO Bool
hasGitDir User
user) forall a b. (a -> b) -> a -> b
$ 
	Property DebianLike
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [UserName] -> Property DebianLike
Apt.installed [UserName
"git"]
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (UserName
"githome " forall a. [a] -> [a] -> [a]
++ UserName
u) forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		UserName
home <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> IO UserName
homedir User
user)
		let tmpdir :: UserName
tmpdir = UserName
home UserName -> UserName -> UserName
</> UserName
"githome"
		forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
UserName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties UserName
"githome setup" forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps
			[ User
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [UserName
"git clone " forall a. [a] -> [a] -> [a]
++ UserName
url forall a. [a] -> [a] -> [a]
++ UserName
" " forall a. [a] -> [a] -> [a]
++ UserName
tmpdir]
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			, forall {k} (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property UserName
"moveout" forall a b. (a -> b) -> a -> b
$ IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
				UserName -> UserName -> IO [Bool]
moveout UserName
tmpdir UserName
home
			, forall {k} (metatypes :: k).
SingI metatypes =>
UserName -> Propellor Result -> Property (MetaTypes metatypes)
property UserName
"rmdir" forall a b. (a -> b) -> a -> b
$ IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
				forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ UserName -> IO ()
removeDirectory UserName
tmpdir
			, User
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [UserName
"rm -rf .aptitude/ .bashrc .profile"]
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			-- Set HOSTNAME so that this sees the right
			-- hostname when run in a chroot with a different
			-- hostname than the current one.
			, User
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [UserName
"HOSTNAME=$(cat /etc/hostname) bin/mr checkout"]
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			, User
-> [UserName]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [UserName
"bin/fixups"]
				forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
	moveout :: UserName -> UserName -> IO [Bool]
moveout UserName
tmpdir UserName
home = do
		[UserName]
fs <- UserName -> IO [UserName]
dirContents UserName
tmpdir
		forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [UserName]
fs forall a b. (a -> b) -> a -> b
$ \UserName
f -> UserName -> [CommandParam] -> IO Bool
boolSystem UserName
"mv" [UserName -> CommandParam
File UserName
f, UserName -> CommandParam
File UserName
home]

url :: String
url :: UserName
url = UserName
"git://git.kitenet.net/joey/home"

hasGitDir :: User -> IO Bool
hasGitDir :: User -> IO Bool
hasGitDir User
user = UserName -> IO Bool
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User -> IO UserName
homedir User
user
  where
	go :: UserName -> IO Bool
go UserName
home = UserName -> IO Bool
doesDirectoryExist (UserName
home UserName -> UserName -> UserName
</> UserName
".git")