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 exportdir = setup <!> unsetup
  where
        setup = containsLine conf (mkl "tcp4")
                `requires`
                containsLine conf (mkl "tcp6")
                `requires`
                dirExists exportdir
                `requires`
                Apt.serviceInstalledRunning "openbsd-inetd"
                `onChange`
                Service.reloaded "openbsd-inetd"
                `describe` ("git-daemon exporting " ++ exportdir)
        unsetup = lacksLine conf (mkl "tcp4")
                `requires`
                lacksLine conf (mkl "tcp6")
                `onChange`
                Service.reloaded "openbsd-inetd"

        conf = "/etc/inetd.conf"

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

installed :: Property DebianLike
installed = Apt.installed ["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 owner url dir mbranch = check originurl go
        `requires` installed
  where
        desc = "git cloned " ++ url ++ " to " ++ dir
        gitconfig = dir </> ".git/config"
        originurl = ifM (doesFileExist gitconfig)
                ( do
                        v <- catchDefaultIO Nothing $ headMaybe . lines <$>
                                readProcess "git" ["config", "--file", gitconfig, "remote.origin.url"]
                        return (v /= Just url)
                , return True
                )
        go :: Property DebianLike
        go = property' desc $ \w -> do
                liftIO $ do
                        whenM (doesDirectoryExist dir) $
                                removeDirectoryRecursive dir
                        createDirectoryIfMissing True (takeDirectory dir)
                ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds)
                        `assume` MadeChange
        checkoutcmds =
                -- The </dev/null fixes an intermittent
                -- "fatal: read error: Bad file descriptor"
                -- when run across ssh with propellor --spin
                [ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
                , Just $ "cd " ++ shellEscape dir
                , ("git checkout " ++) <$> mbranch
                -- In case this repo is exposted via the web,
                -- although the hook to do this ongoing is not
                -- installed here.
                , Just "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 owner url dir mbranch = go
        `requires` cloned owner url dir mbranch
        `describe` desc
  where
        desc = "git pulled " ++ url ++ " to " ++ dir
        go = userScriptProperty owner
                [ "cd " ++ shellEscape dir
                , "git pull"
                ]
                `changesFile` (dir </> ".git" </> "FETCH_HEAD")

isGitDir :: FilePath -> IO Bool
isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir])

data GitShared = Shared Group | SharedAll | NotShared

-- | Sets up a new, empty bare git repository.
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)
                        , userScriptProperty user ["git init --bare --shared=false " ++ shellEscape repo]
                                `assume` MadeChange
                        ]
                SharedAll ->
                        [ ownerGroup repo user (userGroup user)
                        , userScriptProperty user ["git init --bare --shared=all " ++ shellEscape repo]
                                `assume` MadeChange
                        ]
                Shared group' ->
                        [ ownerGroup repo user group'
                        , userScriptProperty user ["git init --bare --shared=group " ++ shellEscape repo]
                                `assume` MadeChange
                        ]
  where
        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 UnixLike
repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $
        userScriptProperty (User "root")
                [ "cd " ++ repo
                , "git config " ++ key ++ " " ++ value
                ]
                `assume` MadeChange
                `describe` desc
  where
        alreadyconfigured = do
                vs <- getRepoConfig repo key
                return $ value `elem` vs
        desc = "git repo at " ++ repo  ++ " config setting " ++ key ++ " set to " ++ value

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

-- | Whether a repo accepts non-fast-forward pushes.
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs repo = accepts <!> refuses
  where
        accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")
                `describe` desc "accepts"
        refuses = repoConfigured repo ("receive.denyNonFastForwards", "true")
                `describe` desc "rejects"
        desc s = "git repo " ++ repo ++ " " ++ s ++ " 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 repo branch =
        userScriptProperty (User "root")
                [ "cd " ++ repo
                , "git symbolic-ref HEAD refs/heads/" ++ branch
                ]
        `changesFileContent` (repo </> "HEAD")
        `describe` ("git repo at " ++ repo ++ " has default branch " ++ branch)