moving to filterdriver branch

Not used in master, so remove until/unless filterdriver branch is
merged.

Git/Protocol/LongRunningProcess.hs

@@ -1,141 +0,0 @@
-{- Git long-running process protocol, as documented in 
- - git/Documentation/technical/long-running-process-protocol.txt
- -
- - Copyright 2018 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE LambdaCase #-}
-
-module Git.Protocol.LongRunningProcess where
-
-import Git.Protocol.PktLine
-
-import Data.List
-import Data.Monoid
-import Control.Applicative
-import System.IO
-
-data ClientServer = Client | Server
-	deriving (Show)
-
-clientServerSuffix :: ClientServer -> String
-clientServerSuffix Client = "-client"
-clientServerSuffix Server = "-server"
-
-data Role = Role ClientServer String
-	deriving (Show)
-
-parseRole :: String -> Maybe Role
-parseRole s = go Client <|> go Server
-  where
-	go cs = 
-		let suffix = clientServerSuffix cs
-		in if suffix `isSuffixOf` s
-			then Just $ Role cs $
-				take (length s - length suffix) s
-			else Nothing
-
-pktRole :: PktLine -> Maybe Role
-pktRole = parseRole . pktLineString
-
-rolePkt :: Role -> Maybe PktLine
-rolePkt (Role cs t) = stringPktLine $ t <> clientServerSuffix cs
-
-newtype Capability = Capability { fromCapability :: String }
-	deriving (Show, Eq)
-
-pktCapability :: PktLine -> Maybe Capability
-pktCapability = parseKV "capability" Capability
-
-capabilityPkt :: Capability -> Maybe PktLine
-capabilityPkt = formatKV "capability" fromCapability
-
-newtype Version = Version { fromVersion :: String }
-	deriving (Show, Eq)
-
-pktVersion :: PktLine -> Maybe Version
-pktVersion = parseKV "version" Version
-
-versionPkt :: Version -> Maybe PktLine
-versionPkt = formatKV "version" fromVersion
-
--- | Runs the protocol's initial handshake.
---
--- The Role selection function should convert a Client role into a
--- Server role; git will be the Client and the program using this module
--- the Server.
-handshake
-	:: (Role -> Either String Role) -- ^ role selection function
-	-> (Capability -> Bool) -- ^ capability selection function
-	-> Handle -- ^ handle to receive data from git
-	-> Handle -- ^ handle to send data to git
-	-> IO (Either String (Role, [Capability]))
-handshake selectrole selectcapability input output =
-	getpkt pktRole $ \role -> checkversion $ 
-		case selectrole role of
-			Left e -> return (Left e)
-			Right myrole -> sendpkt rolePkt myrole $
-				sendpkt versionPkt (Version "2") $ do
-					sendflush
-					exchangecaps $ \mycaps -> return $ 
-						Right (myrole, mycaps)
-  where
-	protoerr e = return $ Left $ e ++ " from git in protocol handshake"
-	
-	sendpkt f v cnt = case f v of
-		Just pkt -> do
-			writePktLine output pkt
-			cnt
-		Nothing -> return $ Left $ 
-			"failed constructing pkt-line packet for: " ++ show v
-	
-	sendflush = do
-		writePktLine output flushPkt
-		hFlush output
-
-	sendpkts _ [] cnt = do
-		sendflush
-		cnt
-	sendpkts f (v:vs) cnt = sendpkt f v $ sendpkts f vs cnt
-
-	getpkt parser cnt = readPktLine input >>= \case
-		Nothing -> protoerr "EOF"
-		Just (Left e) -> return (Left e)
-		Just (Right pkt) -> case parser pkt of
-			Nothing -> protoerr $ "unparsable packet: " ++ show pkt
-			Just v -> cnt v
-	
-	getpkts parser cnt = go []
-	  where
-		go c = getpkt Just $ \pkt ->
-			if pkt == flushPkt
-				then cnt (reverse c)
-				else case parser pkt of
-					Nothing -> protoerr $ "unparsable packet" ++ show pkt
-					Just v -> go (v:c)
-	
-	checkversion cnt = getpkts pktVersion $ \versions ->
-		if any (== Version "2") versions
-			then cnt
-			else return $ Left $
-				"git is using an unsupported protocol version: " ++ show versions
-	
-	exchangecaps cnt = getpkts pktCapability $ \caps -> do
-		let mycaps = filter selectcapability caps
-		sendpkts capabilityPkt mycaps $
-			cnt mycaps
-
-formatKV :: String -> (v -> String) -> v -> Maybe PktLine
-formatKV k f v = stringPktLine $ k <> "=" <> f v
-
-parseKV :: String -> (String -> v) -> PktLine -> Maybe v
-parseKV k mkv = go . pktLineString
-  where
-	kprefix = k <> "="
-	go t
-		| kprefix `isPrefixOf` t = Just $ mkv $ 
-			drop (length kprefix) t
-		| otherwise = Nothing
-

Git/Protocol/PktLine.hs

@@ -1,161 +0,0 @@
-{- Git pkt-line format, as documented in 
- - git/Documentation/technical/protocol-common.txt
- -
- - Copyright 2018 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE OverloadedStrings #-}
-
-module Git.Protocol.PktLine (
-	PktLine,
-	flushPkt,
-	stringPktLine,
-	pktLineString,
-	streamPktLine,
-	encodePktLine,
-	parsePktLine,
-	decodePktLine,
-	splitPktLine,
-	readPktLine,
-	writePktLine,
-) where
-
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-import Data.Attoparsec.ByteString as A
-import Data.Attoparsec.ByteString.Char8 as A
-import Data.Attoparsec.ByteString.Lazy as AL
-import Data.ByteString.Builder
-import Data.Monoid
-import Data.Word
-import System.IO
-
-import Utility.PartialPrelude
-import Utility.FileSystemEncoding
-
--- | A pkt-line encodes a variable length binary string with a maximum size.
---
--- This module only exports smart constructors for legal pkt-lines.
-newtype PktLine = PktLine S.ByteString
-	deriving (Show, Eq)
-
--- | Maximum data that can be contained in a pkt-line, not
--- including the 4 byte length header.
-maxPktLineContent :: Word16
-maxPktLineContent = 65516
-
--- | Maximum length of a pkt-line, including the 4 byte size header.
-maxPktLineLength :: Word16
-maxPktLineLength = 65520
-
--- | The flush-pkt, a special case in the protocol that is often used to
--- eg, signal the end of a stream of binary data.
-flushPkt :: PktLine
-flushPkt = PktLine S.empty
-
--- | Encodes a String as a PktLine. Fails if the String is too large.
---
--- A trailing newline is included after it, as the protocol recommends
--- doing for non-binary data.
-stringPktLine :: String -> Maybe PktLine
-stringPktLine s = 
-	let b = encodeBSS s <> "\n"
-	in if S.length b > fromIntegral maxPktLineContent
-		then Nothing
-		else Just (PktLine b)
-
--- | Extracts a String from a PktLine. Any trailing newline is removed.
-pktLineString :: PktLine -> String
-pktLineString (PktLine b) = 
-	let s = decodeBSS b
-	in if end s == "\n"
-		then beginning s
-		else s
-
--- | Creates a stream of PktLines encoding a lazy ByteString of any size.
--- Note that the stream is not terminated with a flushPkt.
-streamPktLine :: L.ByteString -> [PktLine]
-streamPktLine l =
-	let (chunk, rest) = L.splitAt (fromIntegral maxPktLineContent) l
-	    pktline = PktLine $ mconcat $ L.toChunks chunk
-	in if L.null rest
-		then pktline : []
-		else pktline : streamPktLine rest
-
--- | ByteString builder for a pkt-line.
-encodePktLine :: PktLine -> Builder
-encodePktLine (PktLine b)
-	-- Avoid sending an empty pkt-line; send a flush-pkt instead.
-	| S.null b = "0000"
-	| otherwise = lengthheader <> byteString b
-  where
-	-- The length header is always 4 bytes long, and includes
-	-- itself in its length.
-	lengthheader = word16HexFixed (fromIntegral (S.length b) + 4)
-
--- | Attoparsec parser for a pkt-line.
-parsePktLine :: Parser PktLine
-parsePktLine = parsePktLine' =<< parseLengthHeader
-
-parsePktLine' :: Int -> Parser PktLine
-parsePktLine' len
-	| len == 0 = do
-		endOfInput
-		return flushPkt
-	-- It's impossible for a pkt-line to be less than
-	-- 4 bytes long, since the length header is 4 bytes.
-	| len < 4 = fail "invalid pkt-line length"
-	| otherwise = PktLine <$> A.take (len - 4)
-
-parseLengthHeader :: Parser Int
-parseLengthHeader = do
-	-- Attoparsec's hexidecimal parser will consume any amount
-	-- of hex, but the length header is limited to 4 bytes, so
-	-- take those and parse only them.
-	h <- A.take 4
-	-- Require all 4 bytes to be hexidecimal by using endOfInput.
-	case parseOnly (hexadecimal <* endOfInput) h of
-		Left e -> fail e
-		Right len
-			| len > fromIntegral maxPktLineLength ->
-				fail "pkt-line too long"
-			| otherwise -> return len
-
--- | The ByteString must contain only a pkt-line with no additional data
--- or this will fail.
-decodePktLine :: S.ByteString -> Either String PktLine
-decodePktLine = parseOnly (parsePktLine <* endOfInput)
-
--- | Split the next PktLine from a lazy ByteString, returning it and the
--- remainder of the ByteString.
-splitPktLine :: L.ByteString -> Either String (PktLine, L.ByteString)
-splitPktLine = go . AL.parse parsePktLine
-  where
-	go (AL.Done rest p) = Right (p, rest)
-	go (AL.Fail _ _ e) = Left e
-
--- | Read the next PktLine from a Handle. 
---
--- Nothing is returned at EOF.
-readPktLine :: Handle -> IO (Maybe (Either String PktLine))
-readPktLine h = do
-	header <- S.hGet h 4
-	if S.null header
-		then return Nothing
-		else case parseOnly parseLengthHeader header of
-			Left e -> return $ Just $ Left e
-			Right len
-				| len == 0 -> return $ Just $ Right flushPkt
-				| otherwise -> do
-					-- The header parser rejects headers that
-					-- are too long, so this will never use
-					-- much memory.
-					body <- S.hGet h (len - 4)
-					let parser = parsePktLine' len <* endOfInput
-					return $ Just $ parseOnly parser body
-
--- | Sends a packet to the Handle. Does not flush the Handle.
-writePktLine :: Handle -> PktLine -> IO ()
-writePktLine h = hPutBuilder h . encodePktLine

git-annex.cabal

@@ -847,8 +847,6 @@ Executable git-annex
     Git.LsTree
     Git.Merge
     Git.Objects
-    Git.Protocol.LongRunningProcess
-    Git.Protocol.PktLine
     Git.Queue
     Git.Ref
     Git.RefLog