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

diff --git a/Git/PktLine.hs b/Git/PktLine.hs
new file mode 100644 (file)
index 0000000..dce62d7
--- /dev/null
+++ b/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