1{- git ref stuff
2 -
3 - Copyright 2011-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Git.Ref where
11
12import Common
13import Git
14import Git.Command
15import Git.Sha
16import Git.Types
17import Git.FilePath
18
19import Data.Char (chr, ord)
20import qualified Data.ByteString as S
21import qualified Data.ByteString.Char8 as S8
22
23headRef :: Ref
24headRef = Ref "HEAD"
25
26headFile :: Repo -> FilePath
27headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
28
29setHeadRef :: Ref -> Repo -> IO ()
30setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref)
31
32{- Converts a fully qualified git ref into a user-visible string. -}
33describe :: Ref -> String
34describe = fromRef . base
35
36{- Often git refs are fully qualified
37 - (eg refs/heads/master or refs/remotes/origin/master).
38 - Converts such a fully qualified ref into a base ref
39 - (eg: master or origin/master). -}
40base :: Ref -> Ref
41base = removeBase "refs/heads/" . removeBase "refs/remotes/"
42
43{- Removes a directory such as "refs/heads/master" from a
44 - fully qualified ref. Any ref not starting with it is left as-is. -}
45removeBase :: String -> Ref -> Ref
46removeBase dir r
47	| prefix `isPrefixOf` rs = Ref $ encodeBS $ drop (length prefix) rs
48	| otherwise = r
49  where
50	rs = fromRef r
51	prefix = case end dir of
52		['/'] -> dir
53		_ -> dir ++ "/"
54
55{- Given a directory such as "refs/remotes/origin", and a ref such as
56 - refs/heads/master, yields a version of that ref under the directory,
57 - such as refs/remotes/origin/master. -}
58underBase :: String -> Ref -> Ref
59underBase dir r = Ref $ encodeBS dir <> "/" <> fromRef' (base r)
60
61{- Convert a branch such as "master" into a fully qualified ref. -}
62branchRef :: Branch -> Ref
63branchRef = underBase "refs/heads"
64
65{- A Ref that can be used to refer to a file in the repository, as staged
66 - in the index.
67 -}
68fileRef :: RawFilePath -> IO Ref
69fileRef f = do
70	-- The filename could be absolute, or contain eg "../repo/file",
71	-- neither of which work in a ref, so convert it to a minimal
72	-- relative path.
73	f' <- relPathCwdToFile f
74 	-- Prefixing the file with ./ makes this work even when in a
75	-- subdirectory of a repo. Eg, ./foo in directory bar refers
76	-- to bar/foo, not to foo in the top of the repository.
77	return $ Ref $ ":./" <> toInternalGitPath f'
78
79{- A Ref that can be used to refer to a file in a particular branch. -}
80branchFileRef :: Branch -> RawFilePath -> Ref
81branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f
82
83{- Converts a Ref to refer to the content of the Ref on a given date. -}
84dateRef :: Ref -> RefDate -> Ref
85dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d
86
87{- A Ref that can be used to refer to a file in the repository as it
88 - appears in a given Ref. -}
89fileFromRef :: Ref -> RawFilePath -> IO Ref
90fileFromRef r f = do
91	(Ref fr) <- fileRef f
92	return (Ref (fromRef' r <> fr))
93
94{- Checks if a ref exists. Note that it must be fully qualified,
95 - eg refs/heads/master rather than master. -}
96exists :: Ref -> Repo -> IO Bool
97exists ref = runBool
98	[ Param "show-ref"
99	, Param "--verify"
100	, Param "-q"
101	, Param $ fromRef ref
102	]
103
104{- The file used to record a ref. (Git also stores some refs in a
105 - packed-refs file.) -}
106file :: Ref -> Repo -> FilePath
107file ref repo = fromRawFilePath (localGitDir repo) </> fromRef ref
108
109{- Checks if HEAD exists. It generally will, except for in a repository
110 - that was just created. -}
111headExists :: Repo -> IO Bool
112headExists repo = do
113	ls <- S.split nl <$> pipeReadStrict [Param "show-ref", Param "--head"] repo
114	return $ any (" HEAD" `S.isSuffixOf`) ls
115  where
116	nl = fromIntegral (ord '\n')
117
118{- Get the sha of a fully qualified git ref, if it exists. -}
119sha :: Branch -> Repo -> IO (Maybe Sha)
120sha branch repo = process <$> showref repo
121  where
122	showref = pipeReadStrict
123		[ Param "show-ref"
124		, Param "--hash" -- get the hash
125		, Param $ fromRef branch
126		]
127	process s
128		| S.null s = Nothing
129		| otherwise = Just $ Ref $ firstLine' s
130
131headSha :: Repo -> IO (Maybe Sha)
132headSha = sha headRef
133
134{- List of (shas, branches) matching a given ref or refs. -}
135matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
136matching = matching' []
137
138{- Includes HEAD in the output, if asked for it. -}
139matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
140matchingWithHEAD = matching' [Param "--head"]
141
142matching' :: [CommandParam] -> [Ref] -> Repo -> IO [(Sha, Branch)]
143matching' ps rs repo = map gen . S8.lines <$>
144	pipeReadStrict (Param "show-ref" : ps ++ rps) repo
145  where
146	gen l = let (r, b) = separate' (== fromIntegral (ord ' ')) l
147		in (Ref r, Ref b)
148	rps = map (Param . fromRef) rs
149
150{- List of (shas, branches) matching a given ref.
151 - Duplicate shas are filtered out. -}
152matchingUniq :: [Ref] -> Repo -> IO [(Sha, Branch)]
153matchingUniq refs repo = nubBy uniqref <$> matching refs repo
154  where
155	uniqref (a, _) (b, _) = a == b
156
157{- List of all refs. -}
158list :: Repo -> IO [(Sha, Ref)]
159list = matching' [] []
160
161{- Deletes a ref. This can delete refs that are not branches,
162 - which git branch --delete refuses to delete. -}
163delete :: Sha -> Ref -> Repo -> IO ()
164delete oldvalue ref = run
165	[ Param "update-ref"
166	, Param "-d"
167	, Param $ fromRef ref
168	, Param $ fromRef oldvalue
169	]
170
171{- Gets the sha of the tree a ref uses.
172 -
173 - The ref may be something like a branch name, and it could contain
174 - ":subdir" if a subtree is wanted. -}
175tree :: Ref -> Repo -> IO (Maybe Sha)
176tree (Ref ref) = extractSha <$$> pipeReadStrict
177	[ Param "rev-parse"
178	, Param "--verify"
179	, Param "--quiet"
180	, Param (decodeBS ref')
181	]
182  where
183	ref' = if ":" `S.isInfixOf` ref
184		then ref
185		-- de-reference commit objects to the tree
186		else ref <> ":"
187
188{- Checks if a String is a legal git ref name.
189 -
190 - The rules for this are complex; see git-check-ref-format(1) -}
191legal :: Bool -> String -> Bool
192legal allowonelevel s = all (== False) illegal
193  where
194	illegal =
195		[ any ("." `isPrefixOf`) pathbits
196		, any (".lock" `isSuffixOf`) pathbits
197		, not allowonelevel && length pathbits < 2
198		, contains ".."
199		, any (\c -> contains [c]) illegalchars
200		, begins "/"
201		, ends "/"
202		, contains "//"
203		, ends "."
204		, contains "@{"
205		, null s
206		]
207	contains v = v `isInfixOf` s
208	ends v = v `isSuffixOf` s
209	begins v = v `isPrefixOf` s
210
211	pathbits = splitc '/' s
212	illegalchars = " ~^:?*[\\" ++ controlchars
213	controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)]
214