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