module Propellor.Property.Git where

import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service

import Data.List

-- | Exports all git repos in a directory (that user nobody can read)
-- using git-daemon, run from inetd.
--
-- Note that reverting this property does not remove or stop inetd.
daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
daemonRunning FilePath
exportdir = Property DebianLike
setup Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
unsetup
  where
	setup :: CombinedType
  (CombinedType
     (CombinedType (Property UnixLike) (Property UnixLike))
     (Property DebianLike))
  (Property DebianLike)
setup = FilePath -> FilePath -> Property UnixLike
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath -> FilePath -> Property UnixLike
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath -> Property UnixLike
dirExists FilePath
exportdir
		CombinedType (Property UnixLike) (Property UnixLike)
-> Property DebianLike
-> CombinedType
     (CombinedType (Property UnixLike) (Property UnixLike))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath -> Property DebianLike
Apt.serviceInstalledRunning FilePath
"openbsd-inetd"
		CombinedType
  (CombinedType (Property UnixLike) (Property UnixLike))
  (Property DebianLike)
-> Property DebianLike
-> CombinedType
     (CombinedType
        (CombinedType (Property UnixLike) (Property UnixLike))
        (Property DebianLike))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
		FilePath -> Property DebianLike
Service.reloaded FilePath
"openbsd-inetd"
		CombinedType
  (CombinedType
     (CombinedType (Property UnixLike) (Property UnixLike))
     (Property DebianLike))
  (Property DebianLike)
-> FilePath
-> CombinedType
     (CombinedType
        (CombinedType (Property UnixLike) (Property UnixLike))
        (Property DebianLike))
     (Property DebianLike)
forall p. IsProp p => p -> FilePath -> p
`describe` (FilePath
"git-daemon exporting " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exportdir)
	unsetup :: CombinedType (Property UnixLike) (Property DebianLike)
unsetup = FilePath -> FilePath -> Property UnixLike
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath -> FilePath -> Property UnixLike
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
		Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
		FilePath -> Property DebianLike
Service.reloaded FilePath
"openbsd-inetd"

	conf :: FilePath
conf = FilePath
"/etc/inetd.conf"

	mkl :: FilePath -> FilePath
mkl FilePath
tcpv = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\t"
		[ FilePath
"git"
		, FilePath
"stream"
		, FilePath
tcpv
		, FilePath
"nowait"
		, FilePath
"nobody"
		, FilePath
"/usr/bin/git"
		, FilePath
"git"
		, FilePath
"daemon"
		, FilePath
"--inetd"
		, FilePath
"--export-all"
		, FilePath
"--base-path=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exportdir
		, FilePath
exportdir
		]

installed :: Property DebianLike
installed :: Property DebianLike
installed = [FilePath] -> Property DebianLike
Apt.installed [FilePath
"git"]

type RepoUrl = String

type Branch = String

-- | Specified git repository is cloned to the specified directory.
--
-- If the directory exists with some other content (either a non-git
-- repository, or a git repository cloned from some other location),
-- it will be recursively deleted first.
--
-- A branch can be specified, to check out.
--
-- Does not make subsequent changes be pulled into the repository after
-- it's cloned.
cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
cloned :: User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
cloned User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
originurl Property DebianLike
go
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	desc :: FilePath
desc = FilePath
"git cloned " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
url FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
	gitconfig :: FilePath
gitconfig = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
".git/config"
	originurl :: IO Bool
originurl = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
gitconfig)
		( do
			Maybe FilePath
v <- Maybe FilePath -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe FilePath
forall a. Maybe a
Nothing (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMaybe ([FilePath] -> Maybe FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
				FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"config", FilePath
"--file", FilePath
gitconfig, FilePath
"remote.origin.url"]
			Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
v Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
url)
		, Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
		)
	go :: Property DebianLike
	go :: Property DebianLike
go = FilePath
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
desc ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		IO () -> Propellor ()
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ do
			IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesDirectoryExist FilePath
dir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
				FilePath -> IO ()
removeDirectoryRecursive FilePath
dir
			Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
dir)
		OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
owner ([Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
checkoutcmds)
			UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	checkoutcmds :: [Maybe FilePath]
checkoutcmds = 
		-- The </dev/null fixes an intermittent
		-- "fatal: read error: Bad file descriptor"
		-- when run across ssh with propellor --spin
		[ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"git clone " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
url FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" < /dev/null"
		, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir
		, (FilePath
"git checkout " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
mbranch
		-- In case this repo is exposted via the web,
		-- although the hook to do this ongoing is not
		-- installed here.
		, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"git update-server-info"
		]

-- | Specified git repository is cloned to the specified directory,
-- and any new commits are pulled into it each time this property runs.
pulled :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
pulled :: User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
pulled User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch = Property UnixLike
go
	Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
cloned User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch
	Property DebianLike -> FilePath -> Property DebianLike
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
desc
  where
	desc :: FilePath
desc = FilePath
"git pulled " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
url FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
	go :: Property UnixLike
go = User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
owner
		[ FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir
		, FilePath
"git pull"
		]
		UncheckedProperty UnixLike -> FilePath -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFileContent` (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
".git" FilePath -> FilePath -> FilePath
</> FilePath
"FETCH_HEAD")

isGitDir :: FilePath -> IO Bool
isGitDir :: FilePath -> IO Bool
isGitDir FilePath
dir = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"rev-parse", FilePath
"--resolve-git-dir", FilePath
dir])

data GitShared = Shared Group | SharedAll | NotShared

-- | Sets up a new, empty bare git repository.
bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
bareRepo FilePath
repo User
user GitShared
gitshared = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (FilePath -> IO Bool
isRepo FilePath
repo) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ FilePath -> Props UnixLike -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList (FilePath
"git repo: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo) (Props UnixLike -> Property UnixLike)
-> Props UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ [Property UnixLike] -> Props UnixLike
forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property UnixLike] -> Props UnixLike)
-> [Property UnixLike] -> Props UnixLike
forall a b. (a -> b) -> a -> b
$
	FilePath -> Property UnixLike
dirExists FilePath
repo Property UnixLike -> [Property UnixLike] -> [Property UnixLike]
forall a. a -> [a] -> [a]
: case GitShared
gitshared of
		GitShared
NotShared ->
			[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
			, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=false " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
		GitShared
SharedAll ->
			[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
			, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=all " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
		Shared Group
group' ->
			[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user Group
group'
			, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=group " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
  where
	isRepo :: FilePath -> IO Bool
isRepo FilePath
repo' = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"rev-parse", FilePath
"--resolve-git-dir", FilePath
repo'])

-- | Set a key value pair in a git repo's configuration.
repoConfigured :: FilePath -> (String, String) -> Property UnixLike
FilePath
repo repoConfigured :: FilePath -> (FilePath, FilePath) -> Property UnixLike
`repoConfigured` (FilePath
key, FilePath
value) = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
alreadyconfigured) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
	User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty (FilePath -> User
User FilePath
"root")
		[ FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo
		, FilePath
"git config " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
value
		]
		UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
desc
  where
	alreadyconfigured :: IO Bool
alreadyconfigured = do
		[FilePath]
vs <- FilePath -> FilePath -> IO [FilePath]
getRepoConfig FilePath
repo FilePath
key
		Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
value FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
vs
	desc :: FilePath
desc = FilePath
"git repo at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" config setting " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" set to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
value

-- | Gets the value that a key is set to in a git repo's configuration.
getRepoConfig :: FilePath -> String -> IO [String]
getRepoConfig :: FilePath -> FilePath -> IO [FilePath]
getRepoConfig FilePath
repo FilePath
key = [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO [] (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
	FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"-C", FilePath
repo, FilePath
"config", FilePath
key]

-- | Whether a repo accepts non-fast-forward pushes.
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs FilePath
repo = Property UnixLike
accepts Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
refuses
  where
	accepts :: Property UnixLike
accepts = FilePath -> (FilePath, FilePath) -> Property UnixLike
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"false")
		Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath -> FilePath
desc FilePath
"accepts"
	refuses :: Property UnixLike
refuses = FilePath -> (FilePath, FilePath) -> Property UnixLike
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"true")
		Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath -> FilePath
desc FilePath
"rejects"
	desc :: FilePath -> FilePath
desc FilePath
s = FilePath
"git repo " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" non-fast-forward pushes"

-- | Sets a bare repository's default branch, which will be checked out
-- when cloning it.
bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
bareRepoDefaultBranch :: FilePath -> FilePath -> Property UnixLike
bareRepoDefaultBranch FilePath
repo FilePath
branch =
	User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty (FilePath -> User
User FilePath
"root")
		[ FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo
		, FilePath
"git symbolic-ref HEAD refs/heads/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
branch
		]
	UncheckedProperty UnixLike -> FilePath -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFileContent` (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
"HEAD")
	Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` (FilePath
"git repo at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
repo FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" has default branch " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
branch)