summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Git.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Git.hs')
-rw-r--r--src/Propellor/Property/Git.hs23
1 files changed, 12 insertions, 11 deletions
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index a5ef5ab1..5d7c8b4d 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -11,7 +11,7 @@ import Data.List
-- using git-daemon, run from inetd.
--
-- Note that reverting this property does not remove or stop inetd.
-daemonRunning :: FilePath -> RevertableProperty NoInfo
+daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
daemonRunning exportdir = setup <!> unsetup
where
setup = containsLine conf (mkl "tcp4")
@@ -47,7 +47,7 @@ daemonRunning exportdir = setup <!> unsetup
, exportdir
]
-installed :: Property NoInfo
+installed :: Property DebianLike
installed = Apt.installed ["git"]
type RepoUrl = String
@@ -61,8 +61,8 @@ type Branch = String
-- it will be recursively deleted first.
--
-- A branch can be specified, to check out.
-cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo
-cloned owner url dir mbranch = check originurl (property desc checkout)
+cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
+cloned owner url dir mbranch = check originurl go
`requires` installed
where
desc = "git cloned " ++ url ++ " to " ++ dir
@@ -74,12 +74,13 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
return (v /= Just url)
, return True
)
- checkout = do
+ go :: Property DebianLike
+ go = property' desc $ \w -> do
liftIO $ do
whenM (doesDirectoryExist dir) $
removeDirectoryRecursive dir
createDirectoryIfMissing True (takeDirectory dir)
- ensureProperty $ userScriptProperty owner (catMaybes checkoutcmds)
+ ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds)
`assume` MadeChange
checkoutcmds =
-- The </dev/null fixes an intermittent
@@ -99,8 +100,8 @@ isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--re
data GitShared = Shared Group | SharedAll | NotShared
-bareRepo :: FilePath -> User -> GitShared -> Property NoInfo
-bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $
+bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
+bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $
dirExists repo : case gitshared of
NotShared ->
[ ownerGroup repo user (userGroup user)
@@ -121,7 +122,7 @@ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: "
isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo'])
-- | Set a key value pair in a git repo's configuration.
-repoConfigured :: FilePath -> (String, String) -> Property NoInfo
+repoConfigured :: FilePath -> (String, String) -> Property UnixLike
repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $
userScriptProperty (User "root")
[ "cd " ++ repo
@@ -141,7 +142,7 @@ getRepoConfig repo key = catchDefaultIO [] $
lines <$> readProcess "git" ["-C", repo, "config", key]
-- | Whether a repo accepts non-fast-forward pushes.
-repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo
+repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs repo = accepts <!> refuses
where
accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")
@@ -152,7 +153,7 @@ repoAcceptsNonFFs repo = accepts <!> refuses
-- | Sets a bare repository's default branch, which will be checked out
-- when cloning it.
-bareRepoDefaultBranch :: FilePath -> String -> Property NoInfo
+bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
bareRepoDefaultBranch repo branch =
userScriptProperty (User "root")
[ "cd " ++ repo