| By | fr33domlover |
| At | 2016-04-21 |
| Title | Fixes and exports for RefDiscovery over HTTP in Vervis |
| Description |
Edit file hit-network.cabal 0 → 0
+ 34 Network.Git.Fetch.RefDiscovery
+ 35 Network.Git.Put
… … … … - 45 Network.Git.Fetch.RefDiscovery
- 46 Network.Git.Put
… … … … Edit file src/Data/Git/Local.hs 0 → 0
- 41 listHelper
- 42 :: (Git -> IO (Set RefName))
- 43 -> ByteString
- 44 -> Git
- 45 -> IO [(ObjId, ByteString)]
- 46 listHelper get prefix git = do
+ 41 listHelper :: (Git -> IO (Set RefName)) -> Git -> IO [(ObjId, ByteString)]
+ 42 listHelper get git = do
- 44 let resolve name =
- 45 let nameb = BC.pack name
- 46 in if prefix `B.isPrefixOf` nameb
- 47 then do
- 48 oid <- resolveName git name
- 49 return (oid, B.drop (B.length prefix) nameb)
- 50 else error "found name which doesn't have expected prefix"
+ 40 let resolve name = do
+ 41 oid <- resolveName git name
+ 42 return (oid, BC.pack name)
- 56 listBranches = listHelper branchList "refs/heads/"
+ 48 listBranches = listHelper branchList
- 62 listTags = listHelper tagList "refs/tags/"
+ 54 listTags = listHelper tagList
… … … … Edit file src/Network/Git/Fetch/RefDiscovery.hs 0 → 0
+ 28 , serializeRefDiscover
- 37 import Data.Foldable (traverse_)
+ 38 import Data.Foldable (for_, traverse_)
+ 48 import qualified Data.ByteString.Lazy as BL (ByteString)
… … … … - 93 { rdAds :: [RefAd]- 94 , rdCaps :: [Capability]
+ 95 { rdService :: Maybe ByteString+ 96 , rdAds :: [RefAd]
+ 97 , rdCaps :: [Capability]
… … … … + 141 putService :: ByteString -> Put
+ 142 putService serv =
+ 143 let prefix = "# service="
+ 144 in putDataPkt True (B.length prefix + B.length serv) $ do
+ 145 putByteString prefix
+ 146 putByteString serv
+ 147 - 147 putRefDiscover (RefDiscover [] caps) = do
+ 157 putRefDiscover (RefDiscover mserv [] caps) = do
+ 158 for_ mserv putService
- 151 putRefDiscover (RefDiscover (a:as) caps) = do
+ 162 putRefDiscover (RefDiscover mserv (a:as) caps) = do
+ 163 for_ mserv putService
+ 169 serializeRefDiscover :: RefDiscover -> BL.ByteString
+ 170 serializeRefDiscover = runPut . putRefDiscover
+ 171 - 164 buildRefDiscover' :: Git -> IO RefDiscover
- 165 buildRefDiscover' git = do
+ 179 buildRefDiscover' :: Git -> Maybe ByteString -> IO RefDiscover
+ 180 buildRefDiscover' git mserv = do
… … … … - 194 let l' = tag2ad oid name : l
- 195 in case mpeel of
- 196 Nothing -> l'
- 197 Just p -> peel2ad name p : l'
+ 209 let l' = case mpeel of
+ 210 Nothing -> l
+ 211 Just p -> peel2ad name p : l
+ 212 in tag2ad oid name : l'
- 199 { rdAds =+ 214 { rdService = mserv+ 215 , rdAds =
… … … …