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 :: Property DebianLike
setup = FilePath
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
dirExists FilePath
exportdir
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath -> Property DebianLike
Apt.serviceInstalledRunning FilePath
"openbsd-inetd"
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
		FilePath -> Property DebianLike
Service.reloaded FilePath
"openbsd-inetd"
		Property DebianLike -> FilePath -> 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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
  (Property DebianLike)
unsetup = FilePath
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		FilePath
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (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 (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 (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 (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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> 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
   (Sing
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Propellor Result)
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$ User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
owner ([Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
checkoutcmds)
			UncheckedProperty
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
	Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (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
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
owner
		[ FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir
		, FilePath
"git pull"
		]
		UncheckedProperty
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
bareRepo FilePath
repo User
user GitShared
gitshared = IO Bool
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (FilePath -> IO Bool
isRepo FilePath
repo) (Property
   (Sing
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ FilePath
-> Props
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
   (Sing
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ [Property
   (Sing
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
    (Sing
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
 -> Props
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
	FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
dirExists FilePath
repo Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> [Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> [Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a. a -> [a] -> [a]
: case GitShared
gitshared of
		GitShared
NotShared ->
			[ FilePath
-> User
-> Group
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
			, User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [FilePath
"git init --bare --shared=false " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
		GitShared
SharedAll ->
			[ FilePath
-> User
-> Group
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
			, User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [FilePath
"git init --bare --shared=all " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
			]
		Shared Group
group' ->
			[ FilePath
-> User
-> Group
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
ownerGroup FilePath
repo User
user Group
group'
			, User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
userScriptProperty User
user [FilePath
"git init --bare --shared=group " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
				UncheckedProperty
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`repoConfigured` (FilePath
key, FilePath
value) = IO Bool
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
   (Sing
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
	User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 (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 (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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
repoAcceptsNonFFs FilePath
repo = Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
accepts Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> RevertableProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
refuses
  where
	accepts :: Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
accepts = FilePath
-> (FilePath, FilePath)
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"false")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath -> FilePath
desc FilePath
"accepts"
	refuses :: Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
refuses = FilePath
-> (FilePath, FilePath)
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"true")
		Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
bareRepoDefaultBranch FilePath
repo FilePath
branch =
	User
-> [FilePath]
-> UncheckedProperty
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFileContent` (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
"HEAD")
	Property
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> FilePath
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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)