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
|
{- git ref stuff
-
- Copyright 2011-2019 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 Data.Char (chr, ord)
import qualified Data.ByteString as S
headRef :: Ref
headRef = Ref "HEAD"
headFile :: Repo -> FilePath
headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
setHeadRef :: Ref -> Repo -> IO ()
setHeadRef ref r = 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 (Ref r)
| prefix `isPrefixOf` r = Ref (drop (length prefix) r)
| otherwise = Ref r
where
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 $ 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.
-
- Prefixing the file with ./ makes this work even if in a subdirectory
- of a repo.
-}
fileRef :: RawFilePath -> Ref
fileRef f = Ref $ ":./" ++ fromRawFilePath f
{- Converts a Ref to refer to the content of the Ref on a given date. -}
dateRef :: Ref -> RefDate -> Ref
dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d
{- A Ref that can be used to refer to a file in the repository as it
- appears in a given Ref. -}
fileFromRef :: Ref -> RawFilePath -> Ref
fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
{- Checks if a ref exists. -}
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 $ decodeBS' $ 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 refs repo = matching' (map fromRef refs) repo
{- Includes HEAD in the output, if asked for it. -}
matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
{- List of (shas, branches) matching a given ref spec. -}
matching' :: [String] -> Repo -> IO [(Sha, Branch)]
matching' ps repo = map gen . lines . decodeBS' <$>
pipeReadStrict (Param "show-ref" : map Param ps) repo
where
gen l = let (r, b) = separate (== ' ') l
in (Ref r, Ref b)
{- 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 . decodeBS <$$> pipeReadStrict
[ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ]
where
ref' = if ":" `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)]
|
