git pkt-line implementation

This module is not used yet, but the plan is to implement
the long running filter process for smudge/clean.

Sponsored-by: Shae Erisson on Patreon

Git/PktLine.hs

@@ -0,0 +1,112 @@
+{- git pkt-line communication format
+ -
+ - As documented in git's Documentation/technical/protocol-common.txt
+ -
+ - Copyright 2021 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Git.PktLine (
+	PktLine,
+	pktLineToByteString,
+	pktLineToString,
+	readPktLine,
+	encodePktLine,
+	stringPktLine,
+	writePktLine,
+	flushPkt,
+	isFlushPkt,
+) where
+
+import System.IO
+import qualified Data.ByteString as B
+import qualified Data.Attoparsec.ByteString.Char8 as A8
+import Text.Printf
+
+import Utility.PartialPrelude
+import Utility.FileSystemEncoding
+
+{- This is a variable length binary string, but its size is limited to
+ - maxPktLineLength. Its serialization includes a 4 byte hexidecimal
+ - prefix giving its total length, including that prefix. -}
+newtype PktLine = PktLine B.ByteString
+	deriving (Show)
+
+pktLineToByteString :: PktLine -> B.ByteString
+pktLineToByteString (PktLine b) = b
+
+{- When the pkt-line contains non-binary data, its serialization
+ - may include a terminating newline. This removes that newline, if it was
+ - present.
+ -
+ - Note that the pkt-line has no defined encoding, and could still
+ - contain something non-ascii, eg a filename. -}
+pktLineToString :: PktLine -> String
+pktLineToString (PktLine b) = 
+	let s = decodeBS b
+	in case lastMaybe s of
+		Just '\n' -> beginning s
+		Nothing -> s
+
+{- Reads the next PktLine from a Handle. Returns Nothing on EOF or when
+ - there is a protocol error. -}
+readPktLine :: Handle -> IO (Maybe PktLine)
+readPktLine h = do
+	lenb <- B.hGet h 4
+	if B.length lenb < 4
+		then return Nothing
+		else case A8.parseOnly (A8.hexadecimal <* A8.endOfInput) lenb of
+			Right len -> go (len - 4) mempty
+			_ -> return Nothing
+  where
+	go n b
+		| n <= 0 = return (Just (PktLine b))
+		| otherwise = do
+			b' <- B.hGet h n
+			if B.length b' == 0
+				then return Nothing -- EOF
+				else go (n - B.length b') (b <> b')
+
+{- Encodes the ByteString as a PktLine. But if the ByteString is too
+ - long to fit in a single PktLine, returns the remainder of it. -}
+encodePktLine :: B.ByteString -> (PktLine, Maybe B.ByteString)
+encodePktLine b
+	| B.length b > maxPktLineLength =
+		let (b', rest) = B.splitAt maxPktLineLength b
+		in (PktLine b', Just rest)
+	| otherwise = (PktLine b, Nothing)
+
+{- If the String is too long to fit in a single PktLine,
+ - will throw an error. -}
+stringPktLine :: String -> PktLine
+stringPktLine s
+	| length s > maxPktLineLength =
+		error "textPktLine called with too-long value"
+	| otherwise = PktLine (encodeBS s <> "\n")
+
+{- Sends a PktLine to a Handle, and flushes it so that it will be
+ - visible to the Handle's reader. -}
+writePktLine :: Handle -> PktLine -> IO ()
+writePktLine h (PktLine b)
+	-- Special case for empty string; avoid encoding as "0004".
+	| B.null b = do
+		B.hPut h "0000"
+		hFlush h
+	| otherwise = do
+		hPutStr h $ printf "%04x" (B.length b + 4)
+		B.hPut h b
+		hFlush h
+
+{- Maximum possible length of the string encoded in PktLine;
+ - the length header takes up 4 bytes. -}
+maxPktLineLength :: Int
+maxPktLineLength = 65535 - 4
+
+flushPkt :: PktLine
+flushPkt = PktLine mempty
+
+isFlushPkt :: PktLine -> Bool
+isFlushPkt (PktLine b) = b == mempty