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