From 43b3616777f6c66bebace0b13e2c9c3d2e8689c4 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 14:20:00 -0300
Subject: [PATCH 01/12] Add decoding offset to hopefully reduce ByteString
 allocations

---
 hpgsql/src/Hpgsql/Encoding.hs                 | 28 +++---
 .../src/Hpgsql/Encoding/BinarySerializer.hs   | 47 +++++----
 hpgsql/src/Hpgsql/Internal.hs                 |  2 +-
 hpgsql/src/Hpgsql/Msgs.hs                     | 10 +-
 hpgsql/src/Hpgsql/SimpleParser.hs             | 96 +++++++++++--------
 5 files changed, 100 insertions(+), 83 deletions(-)

diff --git a/hpgsql/src/Hpgsql/Encoding.hs b/hpgsql/src/Hpgsql/Encoding.hs
index 6a1e771..dd5378f 100644
--- a/hpgsql/src/Hpgsql/Encoding.hs
+++ b/hpgsql/src/Hpgsql/Encoding.hs
@@ -735,9 +735,9 @@ binaryIntDecoder typOid = \bs ->
     maxBoundPgType :: Integer
     intDecoder :: ByteString -> Either String a
     (maxBoundPgType, intDecoder)
-      | typOid == int8Oid = (fromIntegral $ maxBound @Int64, fmap fromIntegral . BinSer.decodeInt64BE)
-      | typOid == int4Oid = (fromIntegral $ maxBound @Int32, fmap fromIntegral . BinSer.decodeInt32BE)
-      | typOid == int2Oid = (fromIntegral $ maxBound @Int16, fmap fromIntegral . BinSer.decodeInt16BE)
+      | typOid == int8Oid = (fromIntegral $ maxBound @Int64, fmap fromIntegral . BinSer.decodeInt64BE 0)
+      | typOid == int4Oid = (fromIntegral $ maxBound @Int32, fmap fromIntegral . BinSer.decodeInt32BE 0)
+      | typOid == int2Oid = (fromIntegral $ maxBound @Int16, fmap fromIntegral . BinSer.decodeInt16BE 0)
       | otherwise = error "Bug in Hpgsql. Decoding binary integral type not an int2, int4 or int8"
     doesFit = maxBoundPgType <= fromIntegral (maxBound @a)
 
@@ -991,7 +991,7 @@ instance FromPgField UTCTime where
   fieldDecoder = parsePgType [timestamptzOid] $ \case
     Just bs -> do
       -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909
-      totalusecs <- BinSer.decodeInt64BE bs
+      totalusecs <- BinSer.decodeInt64BE 0 bs
       let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day
           parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19
       Right $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)
@@ -1001,7 +1001,7 @@ instance FromPgField (Unbounded UTCTime) where
   fieldDecoder = parsePgType [timestamptzOid] $ \case
     Just bs -> do
       -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909
-      totalusecs <- BinSer.decodeInt64BE bs
+      totalusecs <- BinSer.decodeInt64BE 0 bs
       Right $
         if totalusecs == minBound
           then NegInfinity
@@ -1018,7 +1018,7 @@ instance FromPgField ZonedTime where
   fieldDecoder = parsePgType [timestamptzOid] $ \case
     Just bs -> do
       -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909
-      totalusecs <- BinSer.decodeInt64BE bs
+      totalusecs <- BinSer.decodeInt64BE 0 bs
       let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day
           parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19
       Right $ utcToZonedTime utc $ UTCTime parsedDate (picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)
@@ -1028,7 +1028,7 @@ instance FromPgField (Unbounded ZonedTime) where
   fieldDecoder = parsePgType [timestamptzOid] $ \case
     Just bs -> do
       -- See https://github.com/postgres/postgres/blob/50cb7505b3010736b9a7922e903931534785f3aa/src/backend/utils/adt/timestamp.c#L1909
-      totalusecs <- BinSer.decodeInt64BE bs
+      totalusecs <- BinSer.decodeInt64BE 0 bs
       Right $
         if totalusecs == minBound
           then NegInfinity
@@ -1044,7 +1044,7 @@ instance FromPgField (Unbounded ZonedTime) where
 instance FromPgField LocalTime where
   fieldDecoder = parsePgType [timestampOid] $ \case
     Just bs -> do
-      totalusecs <- BinSer.decodeInt64BE bs
+      totalusecs <- BinSer.decodeInt64BE 0 bs
       let (day, timeusecs) = totalusecs `divMod` 86_400_000_000 -- USECS per day
           parsedDate = addJulianDurationClip (CalendarDiffDays 0 (fromIntegral day)) $ fromJulian 1999 12 19
       Right $ LocalTime parsedDate (timeToTimeOfDay $ picosecondsToDiffTime $ fromIntegral timeusecs * 1_000_000)
@@ -1053,7 +1053,7 @@ instance FromPgField LocalTime where
 instance FromPgField TimeOfDay where
   fieldDecoder = parsePgType [timeOid] $ \case
     Just bs -> do
-      usecs <- BinSer.decodeInt64BE bs
+      usecs <- BinSer.decodeInt64BE 0 bs
       Right $ timeToTimeOfDay $ picosecondsToDiffTime $ fromIntegral usecs * 1_000_000
     Nothing -> Left "Cannot decode SQL null as the Haskell TimeOfDay type. Use a `Maybe TimeOfDay`"
 
@@ -1063,7 +1063,7 @@ instance FromPgField Day where
       -- There is a very specific conversion function for these, which I poorly translated to Haskell
       -- https://github.com/postgres/postgres/blob/799959dc7cf0e2462601bea8d07b6edec3fa0c4f/src/backend/utils/adt/datetime.c#L321
       -- But I found a simpler way to do this. Let's see if it works in our property based tests
-      jd <- BinSer.decodeInt32BE bs
+      jd <- BinSer.decodeInt32BE 0 bs
       Right $ addJulianDurationClip (CalendarDiffDays 0 (fromIntegral jd - 13)) $ fromJulian 2000 01 01
     Nothing -> Left "Cannot decode SQL null as the Haskell Day type. Use a `Maybe Day`"
 
@@ -1073,7 +1073,7 @@ instance FromPgField (Unbounded Day) where
       -- There is a very specific conversion function for these, which I poorly translated to Haskell
       -- https://github.com/postgres/postgres/blob/799959dc7cf0e2462601bea8d07b6edec3fa0c4f/src/backend/utils/adt/datetime.c#L321
       -- But I found a simpler way to do this. Let's see if it works in our property based tests
-      jd <- BinSer.decodeInt32BE bs
+      jd <- BinSer.decodeInt32BE 0 bs
       Right $
         if jd == minBound
           then NegInfinity
@@ -1087,9 +1087,9 @@ instance FromPgField (Unbounded Day) where
 instance FromPgField CalendarDiffTime where
   fieldDecoder = parsePgType [intervalOid] $ \case
     Just bs -> do
-      nMicrosecs <- BinSer.decodeInt64BE bs
-      nDays <- BinSer.decodeInt32BE (BS.drop 8 bs)
-      nMonths <- BinSer.decodeInt32BE (BS.drop 12 bs)
+      nMicrosecs <- BinSer.decodeInt64BE 0 bs
+      nDays <- BinSer.decodeInt32BE 8 bs
+      nMonths <- BinSer.decodeInt32BE 12 bs
       Right $ CalendarDiffTime {ctMonths = fromIntegral nMonths, ctTime = secondsToNominalDiffTime (fromIntegral nDays * 86400) + realToFrac (picosecondsToDiffTime (fromIntegral nMicrosecs * 1_000_000))}
     Nothing -> Left "Cannot decode SQL null as the Haskell CalendarDiffTime type. Use a `Maybe CalendarDiffTime`"
 
diff --git a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
index a21dd27..da6983c 100644
--- a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
+++ b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
@@ -9,7 +9,8 @@
 -- The caveat is that this module makes unaligned memory access. For the target
 -- CPU architectures of this library, this should be fine.
 module Hpgsql.Encoding.BinarySerializer
-  ( decodeInt16BE,
+  ( ByteStringIdx (..),
+    decodeInt16BE,
     decodeInt32BE,
     decodeInt64BE,
     decodeWord32BE,
@@ -37,7 +38,7 @@ import Data.Bits (Bits (unsafeShiftR))
 import qualified Data.ByteString as BS
 import Data.Coerce (coerce)
 import Data.Maybe (fromMaybe)
-import Foreign (Storable (..), peek, (.&.))
+import Foreign (Storable (..), (.&.))
 import Foreign.ForeignPtr (withForeignPtr)
 import GHC.Float (castDoubleToWord64, castFloatToWord32)
 import System.IO.Unsafe (unsafeDupablePerformIO)
@@ -64,12 +65,12 @@ fromBigEndian16 = byteSwap16
 #endif
 
 {-# INLINE unsafeDecodeWord #-}
-unsafeDecodeWord :: (Storable a) => ByteString -> Int -> (a -> a) -> Either String a
-unsafeDecodeWord (InternalBS.BS bytesPtr len) minLen endianConvert =
-  if len >= minLen
+unsafeDecodeWord :: (Storable a) => ByteStringIdx -> ByteString -> Int -> (a -> a) -> Either String a
+unsafeDecodeWord idx (InternalBS.BS bytesPtr len) minLen endianConvert =
+  if len >= minLen + idx.idx
     then
       -- A bang (strictness) in `decodedWord` makes our benchmarks allocate more memory and run slower!
-      let decodedWord = endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peek (coerce ptr)
+      let decodedWord = endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
        in Right decodedWord
     else Left "Less than enough bytes to decode"
 
@@ -79,9 +80,12 @@ unsafeEncodeWord n endianConvert len =
   InternalBS.unsafeCreate len $ \bufferPtr ->
     poke (coerce bufferPtr) $ endianConvert n
 
+newtype ByteStringIdx = ByteStringIdx {idx :: Int}
+  deriving newtype (Num)
+
 {-# INLINE decodeInt16BE #-}
-decodeInt16BE :: ByteString -> Either String Int16
-decodeInt16BE bs = fromIntegral <$> unsafeDecodeWord bs 2 fromBigEndian16
+decodeInt16BE :: ByteStringIdx -> ByteString -> Either String Int16
+decodeInt16BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 2 fromBigEndian16
 
 {-# INLINE encodeInt16BE #-}
 encodeInt16BE :: Int16 -> ByteString
@@ -89,23 +93,23 @@ encodeInt16BE n = unsafeEncodeWord (fromIntegral n) fromBigEndian16 2
 
 {-# INLINE decodeWord32BE #-}
 decodeWord32BE :: ByteString -> Either String Word32
-decodeWord32BE bs = unsafeDecodeWord bs 4 fromBigEndian32
+decodeWord32BE bs = unsafeDecodeWord 0 bs 4 fromBigEndian32
 
 {-# INLINE decodeWord64BE #-}
 decodeWord64BE :: ByteString -> Either String Word64
-decodeWord64BE bs = unsafeDecodeWord bs 8 fromBigEndian64
+decodeWord64BE bs = unsafeDecodeWord 0 bs 8 fromBigEndian64
 
 {-# INLINE decodeInt32BE #-}
-decodeInt32BE :: ByteString -> Either String Int32
-decodeInt32BE bs = fromIntegral <$> unsafeDecodeWord bs 4 fromBigEndian32
+decodeInt32BE :: ByteStringIdx -> ByteString -> Either String Int32
+decodeInt32BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 4 fromBigEndian32
 
 {-# INLINE encodeInt32BE #-}
 encodeInt32BE :: Int32 -> ByteString
 encodeInt32BE n = unsafeEncodeWord (fromIntegral n) fromBigEndian32 4
 
 {-# INLINE decodeInt64BE #-}
-decodeInt64BE :: ByteString -> Either String Int64
-decodeInt64BE bs = fromIntegral <$> unsafeDecodeWord bs 8 fromBigEndian64
+decodeInt64BE :: ByteStringIdx -> ByteString -> Either String Int64
+decodeInt64BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 8 fromBigEndian64
 
 {-# INLINE encodeInt64BE #-}
 encodeInt64BE :: Int64 -> ByteString
@@ -128,16 +132,16 @@ encodePgBoolean v = if v then "\SOH" else "\NUL"
 -- | A super specialized decoder to decode a postgres DataRow message
 -- more quickly than a naive implementation.
 -- Returns first the parsed DataRow (only column sizes and values) and second
--- the left-unparsed original bytestring.
-decodeDataRow :: ByteString -> Either String (ByteString, ByteString)
-decodeDataRow bs@(InternalBS.BS _bytesPtr len) =
+-- the index into the left-unparsed contents of the supplied bytestring.
+decodeDataRow :: ByteStringIdx -> ByteString -> Either String (ByteString, ByteStringIdx)
+decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
   -- We have a fast path when rows are at least 8 bytes long (should be the case
   -- for all but 0-column query results or bytestring chunks "cut in the middle of the message")
   -- by playing with bitwise operations.
   -- Whether this is worth keeping is sort of questionable. It's complex
   -- (even if I think it's safe and well tested) and reduces runtime of one of
   -- our benchmarks by 2% compared to not having it.
-  case unsafeDecodeWord bs 8 fromBigEndian64 of
+  case unsafeDecodeWord idx bs 8 fromBigEndian64 of
     Right (w64 :: Word64) ->
       -- After fromBigEndian64, the Word64 has bytes in big-endian order:
       -- byte 0 (msg type) in MSB, bytes 1-4 (length) next, bytes 5-6 (col count), byte 7 in LSB.
@@ -153,13 +157,14 @@ decodeDataRow bs@(InternalBS.BS _bytesPtr len) =
       -- we still have to try to parse that.
       if len >= 5
         then
-          let (InternalBS.w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ BS.uncons bs
-              lenFullMsg = fromIntegral $ either error id (decodeInt32BE lenbs)
+          -- TODO: Don't allocate "lenbs" and decodeInt32BE with offset=1?
+          let (InternalBS.w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ BS.uncons $ BS.drop idx.idx bs
+              lenFullMsg = fromIntegral $ either error id (decodeInt32BE 0 lenbs)
            in if msgIdentChar == 'D'
                 then toResult lenFullMsg
                 else Left "Not a DataRow"
         else Left "Less than enough bytes to decode a DataRow"
   where
     toResult lenFullMsg
-      | len >= 1 + lenFullMsg = let (a, rest) = BS.splitAt (1 + lenFullMsg) bs in Right (BS.drop 7 a, rest)
+      | len >= 1 + lenFullMsg + idx.idx = let a = BS.take (lenFullMsg - 6) (BS.drop (7 + idx.idx) bs) in Right (a, ByteStringIdx $ 1 + lenFullMsg + idx.idx)
       | otherwise = Left "Less than enough bytes to decode a full DataRow"
diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs
index 71d6de0..9bd70f2 100644
--- a/hpgsql/src/Hpgsql/Internal.hs
+++ b/hpgsql/src/Hpgsql/Internal.hs
@@ -534,7 +534,7 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
   (initialBuf, initialBufLen) <- receiveUntilBufferHasAtLeast 5
   let charAndLength = LBS.take 5 initialBuf
   let (w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ LBS.uncons charAndLength
-      lenLeftToFetch :: Int64 = fromIntegral $ either error id (BinSer.decodeInt32BE $ LBS.toStrict lenbs) - 4
+      lenLeftToFetch :: Int64 = fromIntegral $ either error id (BinSer.decodeInt32BE 0 $ LBS.toStrict lenbs) - 4
       fullMessageLen = 5 + lenLeftToFetch
   (nowBuf, _nowBufLen) <- if initialBufLen >= fullMessageLen then pure (initialBuf, initialBufLen) else receiveUntilBufferHasAtLeast fullMessageLen
   let restOfMsg = LBS.drop 5 $ LBS.take fullMessageLen nowBuf
diff --git a/hpgsql/src/Hpgsql/Msgs.hs b/hpgsql/src/Hpgsql/Msgs.hs
index 9e1f6cf..50fe22c 100644
--- a/hpgsql/src/Hpgsql/Msgs.hs
+++ b/hpgsql/src/Hpgsql/Msgs.hs
@@ -54,7 +54,7 @@ colParser = do
   colName <- nulTerminatedCStringParser -- Column name as C string
   void $ Parsec.take (4 + 2)
   -- TODO: OIDs are unsigned integers! Try `select (-1)::oid` to see. Change to UInt32 somehow
-  typOid <- either fail pure . BinSer.decodeInt32BE =<< Parsec.take 4
+  typOid <- either fail pure . BinSer.decodeInt32BE 0 =<< Parsec.take 4
   void $ Parsec.take (2 + 4 + 2)
   pure (colName, Oid (fromIntegral typOid))
 
@@ -138,7 +138,7 @@ data Terminate = Terminate
 
 instance FromPgMessage AuthenticationResponse where
   msgParser = PgMsgParser $ \c restOfMsg -> case c of
-    'R' -> case first (BinSer.decodeInt32BE . LBS.toStrict) $ LBS.splitAt 4 restOfMsg of
+    'R' -> case first (BinSer.decodeInt32BE 0 . LBS.toStrict) $ LBS.splitAt 4 restOfMsg of
       (Right 0, _) -> Just $ AuthenticationResponse AuthOk
       (Right 2, _) -> Just $ AuthenticationResponse AuthKerberosV5
       (Right 3, _) -> Just $ AuthenticationResponse AuthCleartextPassword
@@ -155,7 +155,7 @@ instance FromPgMessage AuthenticationResponse where
 
 instance FromPgMessage BackendKeyData where
   msgParser = PgMsgParser $ \c (LBS.splitAt 4 -> (pidBS, backendSecretKey)) -> case c of
-    'K' -> case BinSer.decodeInt32BE $ LBS.toStrict pidBS of
+    'K' -> case BinSer.decodeInt32BE 0 $ LBS.toStrict pidBS of
       Right pid -> Just $ BackendKeyData {backendPid = pid, backendSecretKey = LBS.toStrict backendSecretKey}
       Left _ -> Nothing
     _ -> Nothing
@@ -359,7 +359,7 @@ instance FromPgMessage RowDescription where
     if c == 'T'
       then
         let (numColsBS, colContents) = LBS.splitAt 2 restOfMsg
-            numCols = either error id $ BinSer.decodeInt16BE $ LBS.toStrict numColsBS
+            numCols = either error id $ BinSer.decodeInt16BE 0 $ LBS.toStrict numColsBS
             allColOidsParser :: Parsec.Parser [(Text, Oid)]
             allColOidsParser = replicateM (fromIntegral numCols) colParser
          in case LazyParsec.parseOnly (allColOidsParser <* Parsec.endOfInput) colContents of
@@ -406,7 +406,7 @@ instance FromPgMessage NotificationResponse where
       then Nothing
       else
         let (notifierPidBs, channelNameAndPayload) = LBS.splitAt 4 restOfMsg
-            notifierPid = either error id $ BinSer.decodeInt32BE $ LBS.toStrict notifierPidBs
+            notifierPid = either error id $ BinSer.decodeInt32BE 0 $ LBS.toStrict notifierPidBs
          in case LazyParsec.parseOnly
               ((NotificationResponse notifierPid <$> nulTerminatedCStringParser <*> nulTerminatedCStringParser) <* Parsec.endOfInput)
               channelNameAndPayload of
diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index 64a13bd..d4f4b1d 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -28,6 +28,7 @@ where
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Int (Int16, Int32, Int64)
+import Hpgsql.Encoding.BinarySerializer (ByteStringIdx (..))
 import qualified Hpgsql.Encoding.BinarySerializer as BinSer
 import Prelude hiding (take)
 
@@ -40,128 +41,139 @@ data ParseResult a
 newtype Parser a = Parser
   { unParser ::
       forall r.
+      ByteStringIdx ->
       ByteString ->
       (String -> r) ->
       -- \^ failure continuation
-      (a -> ByteString -> r) ->
-      -- \^ success continuation, taking left-unparsed ByteString and parsed value
+      (a -> ByteStringIdx -> ByteString -> r) ->
+      -- \^ success continuation, taking original or new ByteString, the index into the original/new bytestring of the first yet-unparsed byte, and parsed value
       r
   }
 
 instance Functor Parser where
-  fmap f (Parser p) = Parser $ \bs kf ks ->
-    p bs kf (\a bs' -> ks (f a) bs')
+  fmap f (Parser p) = Parser $ \idx bs kf ks ->
+    p idx bs kf (\a bs' -> ks (f a) bs')
   {-# INLINE fmap #-}
 
 instance Applicative Parser where
-  pure a = Parser $ \bs _ ks -> ks a bs
+  pure a = Parser $ \idx bs _ ks -> ks a idx bs
   {-# INLINE pure #-}
 
-  Parser pf <*> Parser pa = Parser $ \bs kf ks ->
-    pf bs kf (\f bs' -> pa bs' kf (\a bs'' -> ks (f a) bs''))
+  Parser pf <*> Parser pa = Parser $ \idx bs kf ks ->
+    pf idx bs kf (\f bs' idx' -> pa bs' idx' kf (\a bs'' idx'' -> ks (f a) bs'' idx''))
   {-# INLINE (<*>) #-}
 
 instance Monad Parser where
   return = pure
   {-# INLINE return #-}
 
-  Parser p >>= k = Parser $ \bs kf ks ->
-    p bs kf (\a bs' -> unParser (k a) bs' kf ks)
+  Parser p >>= k = Parser $ \idx bs kf ks ->
+    p idx bs kf (\a bs' idx' -> unParser (k a) bs' idx' kf ks)
   {-# INLINE (>>=) #-}
 
 instance MonadFail Parser where
-  fail msg = Parser $ \_ kf _ -> kf msg
+  fail msg = Parser $ \_ _ kf _ -> kf msg
   {-# INLINE fail #-}
 
 -- | Run a parser and return either an error message or the parsed value,
 -- using the strict 'ParseResult' type. Any unconsumed trailing input is
 -- discarded.
 parseOnly :: Parser a -> ByteString -> ParseResult a
-parseOnly (Parser p) bs = p bs ParseFail (\a _ -> ParseOk a)
+parseOnly p = parseOnlyOffset p 0
 {-# INLINE parseOnly #-}
 
+-- | Run a parser and return either an error message or the parsed value,
+-- using the strict 'ParseResult' type. Any unconsumed trailing input is
+-- discarded.
+parseOnlyOffset :: Parser a -> ByteStringIdx -> ByteString -> ParseResult a
+parseOnlyOffset (Parser p) idx bs = p idx bs ParseFail (\a _ _ -> ParseOk a)
+{-# INLINE parseOnlyOffset #-}
+
 -- | Consume exactly @n@ bytes of input, failing if fewer than @n@ bytes
 -- remain.
 take :: Int -> Parser ByteString
-take n = Parser $ \bs kf ks ->
+take n = Parser $ \idx bs kf ks ->
   -- Special-casing n>0 helps reduce memory usage
-  -- by ~1.5% in our benchmarks without a measurable
+  -- by ~1.5% in our behmarks without a measurable
   -- difference in run time
   if n > 0
     then
-      if BS.length bs >= n
-        then case BS.splitAt n bs of
-          (!h, !t) -> ks h t
-        else kf ("take: wanted " <> show n <> " bytes but only " <> show (BS.length bs) <> " remain")
+      let skip = n + idx.idx
+       in if BS.length bs >= skip
+            then case BS.take n $ BS.drop idx.idx bs of
+              !h -> ks h (ByteStringIdx skip) bs
+            else kf ("take: wanted " <> show skip <> " bytes but only " <> show (BS.length bs) <> " remain")
     else
-      ks mempty bs
+      ks mempty idx bs
 {-# INLINE take #-}
 
 {-# INLINE takeInt16BE #-}
 takeInt16BE :: Parser Int16
-takeInt16BE = Parser $ \bs kf ks ->
-  case BinSer.decodeInt16BE bs of
+takeInt16BE = Parser $ \idx bs kf ks ->
+  case BinSer.decodeInt16BE idx bs of
     Left err -> kf err
-    Right v -> ks v (BS.drop 2 bs)
+    Right v -> ks v (idx + 2) bs
 
 {-# INLINE takeInt32BE #-}
 takeInt32BE :: Parser Int32
-takeInt32BE = Parser $ \bs kf ks ->
-  case BinSer.decodeInt32BE bs of
+takeInt32BE = Parser $ \idx bs kf ks ->
+  case BinSer.decodeInt32BE idx bs of
     Left err -> kf err
-    Right v -> ks v (BS.drop 4 bs)
+    Right v -> ks v (idx + 4) bs
 
 {-# INLINE takeInt64BE #-}
 takeInt64BE :: Parser Int64
-takeInt64BE = Parser $ \bs kf ks ->
-  case BinSer.decodeInt64BE bs of
+takeInt64BE = Parser $ \idx bs kf ks ->
+  case BinSer.decodeInt64BE idx bs of
     Left err -> kf err
-    Right v -> ks v (BS.drop 8 bs)
+    Right v -> ks v (idx + 8) bs
 
 {-# INLINE takeDataRow #-}
 
 -- | A specialized parser to parse a postgres DataRow.
 takeDataRow :: Parser ByteString
-takeDataRow = Parser $ \bs kf ks ->
-  case BinSer.decodeDataRow bs of
+takeDataRow = Parser $ \idx bs kf ks ->
+  case BinSer.decodeDataRow idx bs of
     Left err -> kf err
-    Right (thisDataRow, rest) -> ks thisDataRow rest
+    Right (thisDataRow, idxRest) -> ks thisDataRow idxRest bs
 
 parseMany :: Parser a -> Parser [a]
-parseMany p = Parser $ \bs' _kf ks -> let (vs, rest) = go bs' in ks vs rest
+parseMany p = Parser $ \bs' idx _kf ks -> let (vs, rest) = go bs' idx in ks vs 0 rest
   where
-    go bs = case parseOnly (matchLeftUnconsumed p) bs of
-      ParseOk (unconsumed, v) -> let (vs, rest) = go unconsumed in (v : vs, rest)
+    go idx bs = case parseOnlyOffset (matchLeftUnconsumed p) idx bs of
+      ParseOk (unconsumed, v) -> let (vs, rest) = go 0 unconsumed in (v : vs, rest)
       ParseFail _ -> ([], bs)
 {-# INLINE parseMany #-}
 
 -- | Succeeds only when the input has been fully consumed.
 endOfInput :: Parser ()
-endOfInput = Parser $ \bs kf ks ->
-  if BS.null bs then ks () bs else kf "endOfInput: input remaining"
+endOfInput = Parser $ \idx bs kf ks ->
+  if BS.length bs <= idx.idx then ks () idx bs else kf "endOfInput: input remaining"
 {-# INLINE endOfInput #-}
 
 -- | Run a parser and additionally return the slice of input it consumed.
 -- Because the input is a strict 'ByteString', the returned slice is a view
 -- over the original buffer and allocates no extra memory.
 match :: Parser a -> Parser (ByteString, a)
-match (Parser p) = Parser $ \bs kf ks ->
+match (Parser p) = Parser $ \idx bs kf ks ->
   p
+    idx
     bs
     kf
-    ( \a bs' ->
-        let !consumed = BS.take (BS.length bs - BS.length bs') bs
-         in ks (consumed, a) bs'
+    ( \a idx' bs' ->
+        let !consumed = BS.take (idx'.idx - idx.idx) $ BS.drop idx.idx bs
+         in ks (consumed, a) idx' bs'
     )
 {-# INLINE match #-}
 
 -- | Run a parser and additionally return the unconsumed/unparsed ByteString.
 matchLeftUnconsumed :: Parser a -> Parser (ByteString, a)
-matchLeftUnconsumed (Parser p) = Parser $ \bs kf ks ->
+matchLeftUnconsumed (Parser p) = Parser $ \idx bs kf ks ->
   p
+    idx
     bs
     kf
-    ( \a bs' ->
-        ks (bs', a) bs'
+    ( \a idx' bs' ->
+        ks (BS.drop idx'.idx bs', a) idx' bs'
     )
 {-# INLINE matchLeftUnconsumed #-}

From a3346de3b312ec811d9443280eb8e526ce37aa38 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 18:10:00 -0300
Subject: [PATCH 02/12] Multiple-rows-at-once decoding

---
 .../src/Hpgsql/Encoding/BinarySerializer.hs   |  2 +-
 hpgsql/src/Hpgsql/Internal.hs                 | 79 ++++++++++---------
 hpgsql/src/Hpgsql/Msgs.hs                     |  3 +-
 hpgsql/src/Hpgsql/SimpleParser.hs             | 23 ++++--
 4 files changed, 61 insertions(+), 46 deletions(-)

diff --git a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
index da6983c..bc8845f 100644
--- a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
+++ b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
@@ -155,7 +155,7 @@ decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
     Left _ ->
       -- It is possible the DataRow has length less than 8 bytes, so
       -- we still have to try to parse that.
-      if len >= 5
+      if len >= 5 + idx.idx
         then
           -- TODO: Don't allocate "lenbs" and decodeInt32BE with offset=1?
           let (InternalBS.w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ BS.uncons $ BS.drop idx.idx bs
diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs
index 9bd70f2..9fa032c 100644
--- a/hpgsql/src/Hpgsql/Internal.hs
+++ b/hpgsql/src/Hpgsql/Internal.hs
@@ -115,6 +115,7 @@ import qualified Control.Concurrent.STM as STM
 import Control.Exception.Safe (Exception (..), MonadThrow, SomeException, bracket, bracketOnError, finally, handleJust, mask, mask_, onException, throw, toException, tryJust)
 import Control.Monad (forM, forM_, join, unless, void, when)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import Data.ByteString.Internal (w2c)
 import qualified Data.ByteString.Lazy as LBS
 import Data.Data (Proxy (..))
@@ -506,7 +507,7 @@ receiveNextMsgWithMaskedContinuation conn parser f =
     Left (msgIdentChar, mPgError) -> throw IrrecoverableHpgsqlError {hpgsqlDetails = "Could not parse postgres message with ident char " <> Text.pack (show msgIdentChar) <> ". This is an internal error in Hpgsql. Please report it.", innerException = toException <$> mPgError, relatedStatement = Nothing}
 
 data ReceiveWhat a b where
-  ReceiveDataRows :: ReceiveWhat DataRow [DataRow]
+  ReceiveDataRows :: ReceiveWhat DataRow ByteString
   ReceiveArbitraryMsg :: PgMsgParser a -> (Either (Char, Maybe PostgresError) a -> STM b) -> ReceiveWhat a b
 
 -- | Masks asynchronous exceptions in between the moment the message is extracted from
@@ -583,11 +584,13 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
       case receiveWhat of
         ReceiveDataRows ->
           -- Parse as many DataRows as we can to do as much work as we can per buffer "churn"
-          case Parser.parseOnly (Parser.matchLeftUnconsumed (Parser.parseMany customDataRowParser)) (LBS.toStrict nowBuf) of
-            Parser.ParseOk (unconsumedBuffer, msgs@(_ : _)) -> do
-              debugPrint $ "Received " ++ show msgs
-              pure (LBS.fromStrict unconsumedBuffer, Just msgs)
-            _ -> handleUnexpectedMsg $ const $ pure [] -- No error when we stop receiving DataRows, only emptiness
+          let fullBuf = LBS.toStrict nowBuf
+           in case Parser.parseOnly Parser.parseManyRows fullBuf of
+                Parser.ParseOk unconsumedBufferBegin | unconsumedBufferBegin.idx > 0 -> do
+                  let (msgs, unconsumedBuffer) = BS.splitAt unconsumedBufferBegin.idx fullBuf
+                  debugPrint $ "Received one or more messages with total length " ++ show (BS.length msgs)
+                  pure (LBS.fromStrict unconsumedBuffer, Just msgs)
+                _ -> handleUnexpectedMsg $ const $ pure "" -- No error when we stop receiving DataRows, only emptiness
         ReceiveArbitraryMsg parser f ->
           case parsePgMessage msgIdentChar restOfMsg parser of
             Just msg -> do
@@ -595,8 +598,6 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
               fmap (bufferWithoutMsg,) $ Just <$> STM.atomically (f (Right msg))
             Nothing -> handleUnexpectedMsg (f . Left)
 
-    customDataRowParser = DataRow <$> Parser.takeDataRow
-
     -- \| Appends into the internal buffer by reading from the socket
     -- until the buffer has at least N bytes.
     -- Returns the current buffer and its length.
@@ -843,6 +844,8 @@ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId = do
           }
       pure (Just respMsg, newState)
 
+newtype DataRows = DataRows ByteString
+
 -- | After sending one or more queries to the backend, run this function for each query to fetch that query's results.
 -- You must call the returned IO function and consume the returned Stream completely until you get to the
 -- `Either ErrorResponse CommandComplete` object.
@@ -855,7 +858,7 @@ receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId = do
 consumeResults ::
   HPgConnection ->
   QueryId ->
-  IO (Maybe (Either3 NoData RowDescription CopyInResponse), Stream (Of DataRow) IO (Either ErrorResponse CommandComplete))
+  IO (Maybe (Either3 NoData RowDescription CopyInResponse), Stream (Of DataRows) IO (Either ErrorResponse CommandComplete))
 consumeResults conn qryId = do
   -- debugPrint "++++ Inside consumeResults"
   -- We assume it's possible to receive a DataRow here even in the first call because `consumeResults`
@@ -886,29 +889,28 @@ consumeResults conn qryId = do
       pure (mERowDesc, pure $ Right cmd)
     (mERowDesc, Middle3 mDataRow) -> do
       let allOtherRows =
-            S.concat $
-              S.unfold
-                ( \() -> do
-                    mRow <- receiveNextMsgGeneric conn ReceiveDataRows
-                    case mRow of
-                      rows@(_ : _) -> pure $ Right (rows :> ())
-                      [] -> do
-                        stateAfterNextMsg <- snd <$> receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId
-                        case stateAfterNextMsg of
-                          ErrorResponseReceived _ err -> do
-                            receiveReadyForQueryIfNecessary thisThreadId
-                            pure $ Left $ Left err
-                          CommandCompleteReceived _ cmd -> do
-                            receiveReadyForQueryIfNecessary thisThreadId
-                            pure $ Left $ Right cmd
-                          ReadyForQueryReceived errOrCmd _ -> pure $ Left errOrCmd
-                          st -> throwIrrecoverableError $ "Internal error in Hpgsql. After the last DataRow we should get either an ErrorResponse or a CommandComplete message. State: " <> Text.pack (show st)
-                )
-                ()
+            S.unfold
+              ( \() -> do
+                  mRow <- receiveNextMsgGeneric conn ReceiveDataRows
+                  case mRow of
+                    rows | not (BS.null rows) -> pure $ Right (DataRows rows :> ())
+                    _ -> do
+                      stateAfterNextMsg <- snd <$> receiveOutstandingResponseMsgsAtomically thisThreadId conn qryId
+                      case stateAfterNextMsg of
+                        ErrorResponseReceived _ err -> do
+                          receiveReadyForQueryIfNecessary thisThreadId
+                          pure $ Left $ Left err
+                        CommandCompleteReceived _ cmd -> do
+                          receiveReadyForQueryIfNecessary thisThreadId
+                          pure $ Left $ Right cmd
+                        ReadyForQueryReceived errOrCmd _ -> pure $ Left errOrCmd
+                        st -> throwIrrecoverableError $ "Internal error in Hpgsql. After the last DataRow we should get either an ErrorResponse or a CommandComplete message. State: " <> Text.pack (show st)
+              )
+              ()
           finalStream = case mDataRow of
             Nothing -> allOtherRows
             Just dr ->
-              dr `S.cons` allOtherRows
+              DataRows dr.rowColumnData `S.cons` allOtherRows
       pure (mERowDesc, finalStream)
   where
     receiveReadyForQueryIfNecessary :: WeakThreadId -> IO ()
@@ -1409,17 +1411,18 @@ consumeStreamingResults rp conn qryId = S.effect $ do
           let typecheckedColInfos = rtypecheck colInfos
           unless (numResultColumns == expectedNumCols) $ throwIrrecoverableErrorWithStatement qText $ "Query result contains " <> Text.pack (show numResultColumns) <> " columns but row parser expected " <> Text.pack (show expectedNumCols)
           unless (all snd typecheckedColInfos) $ throwIrrecoverableErrorWithStatement qText "Query result column types do not match expected column types"
-          pure $ rparser colInfos <* Parser.endOfInput
-        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ fmap fst $ rparser ConversionState {colsLeftToParse = colInfos} <* Parser.endOfInput
+          pure $ Parser.take 7 *> rparser colInfos -- Skip msg ident., length, number of columns, then parse fields
+        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ Parser.take 7 *> fmap fst (rparser ConversionState {colsLeftToParse = colInfos})
       pure $ do
         errOrCmdComplete <-
-          S.mapM
-            ( \(DataRow rowColumnData) ->
-                case Parser.parseOnly rowparser rowColumnData of
-                  Parser.ParseOk row -> pure row
-                  Parser.ParseFail err -> throwIrrecoverableErrorWithStatement qText $ "Failed parsing a row: " <> Text.pack (show err)
-            )
-            rowsStream
+          S.concat $
+            S.mapM
+              ( \(DataRows rowColumnData) ->
+                  case Parser.parseOnly (Parser.parseMany rowparser <* Parser.endOfInput) rowColumnData of
+                    Parser.ParseOk rows -> pure rows
+                    Parser.ParseFail err -> throwIrrecoverableErrorWithStatement qText $ "Failed parsing a row: " <> Text.pack (show err)
+              )
+              rowsStream
         S.effect $ case errOrCmdComplete of
           Left err -> throwPostgresError qText err
           Right _cmdComplete -> pure mempty
diff --git a/hpgsql/src/Hpgsql/Msgs.hs b/hpgsql/src/Hpgsql/Msgs.hs
index 50fe22c..e19822e 100644
--- a/hpgsql/src/Hpgsql/Msgs.hs
+++ b/hpgsql/src/Hpgsql/Msgs.hs
@@ -225,7 +225,8 @@ instance FromPgMessage CopyInResponse where
 
 instance FromPgMessage DataRow where
   msgParser = PgMsgParser $ \c !restOfMsg -> case c of
-    'D' -> Just $ DataRow {rowColumnData = LBS.toStrict $ LBS.drop 2 restOfMsg}
+    -- TODO: Double-check the re-encoding here is correct!
+    'D' -> Just $ DataRow {rowColumnData = BS.singleton 68 <> BinSer.encodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg}
     _ -> Nothing
 
 instance FromPgMessage NoData where
diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index d4f4b1d..f8ea42e 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -22,6 +22,7 @@ module Hpgsql.SimpleParser
     takeInt32BE,
     takeInt64BE,
     takeDataRow,
+    parseManyRows,
   )
 where
 
@@ -137,14 +138,23 @@ takeDataRow = Parser $ \idx bs kf ks ->
     Left err -> kf err
     Right (thisDataRow, idxRest) -> ks thisDataRow idxRest bs
 
+-- TODO: Get rid of parseMany to save on List allocations for DataRows?
 parseMany :: Parser a -> Parser [a]
-parseMany p = Parser $ \bs' idx _kf ks -> let (vs, rest) = go bs' idx in ks vs 0 rest
+parseMany p = Parser $ \idx' bs' _kf ks -> let (vs, restIdx) = go idx' bs' in ks vs restIdx bs'
   where
     go idx bs = case parseOnlyOffset (matchLeftUnconsumed p) idx bs of
-      ParseOk (unconsumed, v) -> let (vs, rest) = go 0 unconsumed in (v : vs, rest)
-      ParseFail _ -> ([], bs)
+      ParseOk (unconsumedIdx, v) -> let (vs, rest) = go unconsumedIdx bs in (v : vs, rest)
+      ParseFail _ -> ([], idx)
 {-# INLINE parseMany #-}
 
+parseManyRows :: Parser ByteStringIdx
+parseManyRows = Parser $ \idx' bs' _kf ks -> let restIdx = go idx' bs' in ks restIdx restIdx bs'
+  where
+    go idx bs = case parseOnlyOffset (matchLeftUnconsumed takeDataRow) idx bs of
+      ParseOk (unconsumedIdx, _) -> go unconsumedIdx bs
+      ParseFail _ -> idx
+{-# INLINE parseManyRows #-}
+
 -- | Succeeds only when the input has been fully consumed.
 endOfInput :: Parser ()
 endOfInput = Parser $ \idx bs kf ks ->
@@ -166,14 +176,15 @@ match (Parser p) = Parser $ \idx bs kf ks ->
     )
 {-# INLINE match #-}
 
--- | Run a parser and additionally return the unconsumed/unparsed ByteString.
-matchLeftUnconsumed :: Parser a -> Parser (ByteString, a)
+-- | Run a parser and additionally return the index to the first unconsumed/unparsed byte
+-- in the supplied ByteString.
+matchLeftUnconsumed :: Parser a -> Parser (ByteStringIdx, a)
 matchLeftUnconsumed (Parser p) = Parser $ \idx bs kf ks ->
   p
     idx
     bs
     kf
     ( \a idx' bs' ->
-        ks (BS.drop idx'.idx bs', a) idx' bs'
+        ks (idx', a) idx' bs'
     )
 {-# INLINE matchLeftUnconsumed #-}

From bd7183500b8e39c4b0c01e3de6a49d28872b0af4 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 19:31:50 -0300
Subject: [PATCH 03/12] Get rid of all ByteStrings during parsing

---
 .../src/Hpgsql/Encoding/BinarySerializer.hs   |  7 ++---
 hpgsql/src/Hpgsql/Internal.hs                 |  4 +--
 hpgsql/src/Hpgsql/SimpleParser.hs             | 29 ++++++++++++-------
 3 files changed, 24 insertions(+), 16 deletions(-)

diff --git a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
index bc8845f..9cf1eab 100644
--- a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
+++ b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
@@ -131,9 +131,8 @@ encodePgBoolean v = if v then "\SOH" else "\NUL"
 
 -- | A super specialized decoder to decode a postgres DataRow message
 -- more quickly than a naive implementation.
--- Returns first the parsed DataRow (only column sizes and values) and second
--- the index into the left-unparsed contents of the supplied bytestring.
-decodeDataRow :: ByteStringIdx -> ByteString -> Either String (ByteString, ByteStringIdx)
+-- Returns the index into the left-unparsed contents of the supplied bytestring.
+decodeDataRow :: ByteStringIdx -> ByteString -> Either String ByteStringIdx
 decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
   -- We have a fast path when rows are at least 8 bytes long (should be the case
   -- for all but 0-column query results or bytestring chunks "cut in the middle of the message")
@@ -166,5 +165,5 @@ decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
         else Left "Less than enough bytes to decode a DataRow"
   where
     toResult lenFullMsg
-      | len >= 1 + lenFullMsg + idx.idx = let a = BS.take (lenFullMsg - 6) (BS.drop (7 + idx.idx) bs) in Right (a, ByteStringIdx $ 1 + lenFullMsg + idx.idx)
+      | len >= 1 + lenFullMsg + idx.idx = Right $ ByteStringIdx $ 1 + lenFullMsg + idx.idx
       | otherwise = Left "Less than enough bytes to decode a full DataRow"
diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs
index 9fa032c..a9d3dd6 100644
--- a/hpgsql/src/Hpgsql/Internal.hs
+++ b/hpgsql/src/Hpgsql/Internal.hs
@@ -1411,8 +1411,8 @@ consumeStreamingResults rp conn qryId = S.effect $ do
           let typecheckedColInfos = rtypecheck colInfos
           unless (numResultColumns == expectedNumCols) $ throwIrrecoverableErrorWithStatement qText $ "Query result contains " <> Text.pack (show numResultColumns) <> " columns but row parser expected " <> Text.pack (show expectedNumCols)
           unless (all snd typecheckedColInfos) $ throwIrrecoverableErrorWithStatement qText "Query result column types do not match expected column types"
-          pure $ Parser.take 7 *> rparser colInfos -- Skip msg ident., length, number of columns, then parse fields
-        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ Parser.take 7 *> fmap fst (rparser ConversionState {colsLeftToParse = colInfos})
+          pure $ Parser.skip 7 *> rparser colInfos -- Skip msg ident., length, number of columns, then parse fields
+        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ Parser.skip 7 *> fmap fst (rparser ConversionState {colsLeftToParse = colInfos})
       pure $ do
         errOrCmdComplete <-
           S.concat $
diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index f8ea42e..b60c175 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -23,6 +23,7 @@ module Hpgsql.SimpleParser
     takeInt64BE,
     takeDataRow,
     parseManyRows,
+    skip,
   )
 where
 
@@ -97,17 +98,25 @@ take n = Parser $ \idx bs kf ks ->
   -- Special-casing n>0 helps reduce memory usage
   -- by ~1.5% in our behmarks without a measurable
   -- difference in run time
+  -- TODO check if the comment above still holds
   if n > 0
     then
-      let skip = n + idx.idx
-       in if BS.length bs >= skip
+      let skip' = n + idx.idx
+       in if BS.length bs >= skip'
             then case BS.take n $ BS.drop idx.idx bs of
-              !h -> ks h (ByteStringIdx skip) bs
-            else kf ("take: wanted " <> show skip <> " bytes but only " <> show (BS.length bs) <> " remain")
+              !h -> ks h (ByteStringIdx skip') bs
+            else kf ("take: wanted " <> show skip' <> " bytes but only " <> show (BS.length bs) <> " remain")
     else
       ks mempty idx bs
 {-# INLINE take #-}
 
+-- | Consume exactly @n@ bytes of input, failing if fewer than @n@ bytes
+-- remain.
+skip :: Int -> Parser ()
+skip n = Parser $ \idx bs _ ks ->
+  ks () (ByteStringIdx $ idx.idx + n) bs
+{-# INLINE skip #-}
+
 {-# INLINE takeInt16BE #-}
 takeInt16BE :: Parser Int16
 takeInt16BE = Parser $ \idx bs kf ks ->
@@ -131,14 +140,14 @@ takeInt64BE = Parser $ \idx bs kf ks ->
 
 {-# INLINE takeDataRow #-}
 
--- | A specialized parser to parse a postgres DataRow.
-takeDataRow :: Parser ByteString
+-- | A specialized parser to parse a postgres DataRow,
+-- returning the index of the byte after this DataRow's last.
+takeDataRow :: Parser ByteStringIdx
 takeDataRow = Parser $ \idx bs kf ks ->
   case BinSer.decodeDataRow idx bs of
     Left err -> kf err
-    Right (thisDataRow, idxRest) -> ks thisDataRow idxRest bs
+    Right idxRest -> ks idxRest idxRest bs
 
--- TODO: Get rid of parseMany to save on List allocations for DataRows?
 parseMany :: Parser a -> Parser [a]
 parseMany p = Parser $ \idx' bs' _kf ks -> let (vs, restIdx) = go idx' bs' in ks vs restIdx bs'
   where
@@ -150,8 +159,8 @@ parseMany p = Parser $ \idx' bs' _kf ks -> let (vs, restIdx) = go idx' bs' in ks
 parseManyRows :: Parser ByteStringIdx
 parseManyRows = Parser $ \idx' bs' _kf ks -> let restIdx = go idx' bs' in ks restIdx restIdx bs'
   where
-    go idx bs = case parseOnlyOffset (matchLeftUnconsumed takeDataRow) idx bs of
-      ParseOk (unconsumedIdx, _) -> go unconsumedIdx bs
+    go idx bs = case parseOnlyOffset takeDataRow idx bs of
+      ParseOk unconsumedIdx -> go unconsumedIdx bs
       ParseFail _ -> idx
 {-# INLINE parseManyRows #-}
 

From 3fdb74aa67df9b13a83ddb589b8725c372af6a06 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 20:54:30 -0300
Subject: [PATCH 04/12] Special n>0 optimization makes no sense anymore

It's only used to fetch field values, and values with length exactly 0
are extremely rare
---
 hpgsql/src/Hpgsql/SimpleParser.hs | 18 +++++-------------
 1 file changed, 5 insertions(+), 13 deletions(-)

diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index b60c175..57849c7 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -95,19 +95,11 @@ parseOnlyOffset (Parser p) idx bs = p idx bs ParseFail (\a _ _ -> ParseOk a)
 -- remain.
 take :: Int -> Parser ByteString
 take n = Parser $ \idx bs kf ks ->
-  -- Special-casing n>0 helps reduce memory usage
-  -- by ~1.5% in our behmarks without a measurable
-  -- difference in run time
-  -- TODO check if the comment above still holds
-  if n > 0
-    then
-      let skip' = n + idx.idx
-       in if BS.length bs >= skip'
-            then case BS.take n $ BS.drop idx.idx bs of
-              !h -> ks h (ByteStringIdx skip') bs
-            else kf ("take: wanted " <> show skip' <> " bytes but only " <> show (BS.length bs) <> " remain")
-    else
-      ks mempty idx bs
+  let skip' = n + idx.idx
+   in if BS.length bs >= skip'
+        then case BS.take n $ BS.drop idx.idx bs of
+          !h -> ks h (ByteStringIdx skip') bs
+        else kf ("take: wanted " <> show skip' <> " bytes but only " <> show (BS.length bs) <> " remain")
 {-# INLINE take #-}
 
 -- | Consume exactly @n@ bytes of input, failing if fewer than @n@ bytes

From fb570eafddd9c3edb11c696fcd20e7663220c3ea Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 21:00:26 -0300
Subject: [PATCH 05/12] Add comment on strictness

---
 hpgsql/src/Hpgsql/SimpleParser.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index 57849c7..abac6d4 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -98,6 +98,9 @@ take n = Parser $ \idx bs kf ks ->
   let skip' = n + idx.idx
    in if BS.length bs >= skip'
         then case BS.take n $ BS.drop idx.idx bs of
+          -- Strict on the bytestring because we're pretty sure
+          -- the field decoder will need to evaluate this anyway,
+          -- so no need for an extra thunk
           !h -> ks h (ByteStringIdx skip') bs
         else kf ("take: wanted " <> show skip' <> " bytes but only " <> show (BS.length bs) <> " remain")
 {-# INLINE take #-}

From ef49173bb7ede69eacc54254c1ba6b43bdf156a6 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 21:06:27 -0300
Subject: [PATCH 06/12] Slightly better (but not any faster) specialized row
 decoder

---
 .../src/Hpgsql/Encoding/BinarySerializer.hs   | 21 ++++++++++---------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
index 9cf1eab..35b50fe 100644
--- a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
+++ b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
@@ -32,12 +32,10 @@ import Prelude hiding (encodeFloat)
 #if WORDS_BIGENDIAN
 import Data.Word (Word16, Word32, Word64)
 #else
-import Data.Word (Word16, Word32, Word64, byteSwap16, byteSwap32, byteSwap64)
+import Data.Word (Word16, Word32, Word64, byteSwap16, byteSwap32, byteSwap64, Word8)
 #endif
 import Data.Bits (Bits (unsafeShiftR))
-import qualified Data.ByteString as BS
 import Data.Coerce (coerce)
-import Data.Maybe (fromMaybe)
 import Foreign (Storable (..), (.&.))
 import Foreign.ForeignPtr (withForeignPtr)
 import GHC.Float (castDoubleToWord64, castFloatToWord32)
@@ -91,6 +89,10 @@ decodeInt16BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 2 fromBigEndian1
 encodeInt16BE :: Int16 -> ByteString
 encodeInt16BE n = unsafeEncodeWord (fromIntegral n) fromBigEndian16 2
 
+{-# INLINE decodeWord8 #-}
+decodeWord8 :: ByteStringIdx -> ByteString -> Either String Word8
+decodeWord8 idx bs = unsafeDecodeWord idx bs 1 Prelude.id
+
 {-# INLINE decodeWord32BE #-}
 decodeWord32BE :: ByteString -> Either String Word32
 decodeWord32BE bs = unsafeDecodeWord 0 bs 4 fromBigEndian32
@@ -155,13 +157,12 @@ decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
       -- It is possible the DataRow has length less than 8 bytes, so
       -- we still have to try to parse that.
       if len >= 5 + idx.idx
-        then
-          -- TODO: Don't allocate "lenbs" and decodeInt32BE with offset=1?
-          let (InternalBS.w2c -> msgIdentChar, lenbs) = fromMaybe (error "impossible") $ BS.uncons $ BS.drop idx.idx bs
-              lenFullMsg = fromIntegral $ either error id (decodeInt32BE 0 lenbs)
-           in if msgIdentChar == 'D'
-                then toResult lenFullMsg
-                else Left "Not a DataRow"
+        then do
+          msgIdentChar <- decodeWord8 idx bs
+          lenFullMsg <- decodeInt32BE (1 + idx) bs
+          if msgIdentChar == 68 -- Letter 'D'
+            then toResult (fromIntegral lenFullMsg)
+            else Left "Not a DataRow"
         else Left "Less than enough bytes to decode a DataRow"
   where
     toResult lenFullMsg

From bc93f6f89fc7f7b607cd04bebbb0707016f01fb4 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Tue, 11 Aug 2026 22:13:51 -0300
Subject: [PATCH 07/12] Add a test for the FromPgMessage DataRow decoder

---
 hpgsql-tests/EncodingDecodingSpec.hs | 53 +++++++++++++++++++++++++++-
 hpgsql/src/Hpgsql/Internal.hs        |  2 +-
 hpgsql/src/Hpgsql/InternalTypes.hs   |  4 ++-
 hpgsql/src/Hpgsql/Msgs.hs            |  2 +-
 4 files changed, 57 insertions(+), 4 deletions(-)

diff --git a/hpgsql-tests/EncodingDecodingSpec.hs b/hpgsql-tests/EncodingDecodingSpec.hs
index 37e63cd..03462c6 100644
--- a/hpgsql-tests/EncodingDecodingSpec.hs
+++ b/hpgsql-tests/EncodingDecodingSpec.hs
@@ -1,10 +1,11 @@
 module EncodingDecodingSpec where
 
-import Control.Monad (join, void)
+import Control.Monad (join, replicateM, void)
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Lazy as LBS
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -42,6 +43,7 @@ import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Gen
 import Hpgsql
 import Hpgsql.Connection (ConnectOpts (..), connect, connectOpts, defaultConnectOpts, refreshTypeInfoCache, withConnectionOpts)
+import Hpgsql.InternalTypes (DataRow (..))
 import Hpgsql.Encoding (EncodingContext (..), FieldDecoder (..), FieldEncoder (..), FieldInfo (..), FromPgField (..), FromPgRow (..), LowerCasedPgEnum (..), RowEncoder (..), ToPgField (..), ToPgRow (..), compositeTypeDecoder, compositeTypeEncoder, nullableField, rawBytesFieldDecoder, singleField, typeFieldDecoder, typeFieldEncoder, typeMustBeNamed, typeOidWithName)
 import Hpgsql.Pipeline (pipeline, pipelineWith, runPipeline)
 import Hpgsql.Query (mkQuery, sql, vALUES)
@@ -160,6 +162,9 @@ spec = parallel $ do
   it
     "0-columns results can be decoded"
     zeroColumnsResults
+  it
+    "Specialized DataRow decoding consistency"
+    specializedDataRowDecodingConsistency
 
 zeroColumnsResults :: IO ()
 zeroColumnsResults = do
@@ -872,3 +877,49 @@ valuesTypeRoundTrip conn = hedgehog $ do
 data Person = Person {name :: Text, born :: Day, heightMeters :: Double}
   deriving stock (Generic)
   deriving anyclass (FromPgRow)
+
+specializedDataRowDecodingConsistency :: PropertyT IO ()
+specializedDataRowDecodingConsistency = hedgehog $ do
+  dataRows <- Gen.forAll $ Gen.list (Gen.linear 0 20) genDataRowBS
+  mapM_ (\drBS -> do
+    let restOfMsg = LBS.fromStrict (BS.drop 5 drBS)
+        parsed = parseDataRowFromPgMsg 'D' restOfMsg
+    fmap fullDataRow parsed === Just drBS
+    ) dataRows
+
+-- | Copy of the FromPgMessage DataRow instance's parsing logic from Hpgsql.Msgs.
+-- Keep in sync with that module's @instance FromPgMessage DataRow@.
+parseDataRowFromPgMsg :: Char -> LBS.ByteString -> Maybe DataRow
+parseDataRowFromPgMsg c !restOfMsg = case c of
+  'D' -> Just $ DataRow $ BS.singleton 68 <> testEncodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg
+  _ -> Nothing
+
+genDataRowBS :: Gen.Gen ByteString
+genDataRowBS = do
+  numFields <- Gen.int (Gen.linear 0 10)
+  -- Each NULL field adds 4 bytes overhead (length = -1). Each non-NULL field adds 4 + n bytes.
+  -- A 0-field DataRow is 7 bytes: 1 ('D') + 4 (msg length) + 2 (field count).
+  -- We target a max total of 100 bytes, so 93 bytes are available for fields.
+  let maxPerField = if numFields == 0 then 0 else max 0 ((93 - 4 * numFields) `div` numFields)
+  fields <- replicateM numFields (genField maxPerField)
+  pure $ buildDataRow fields
+  where
+    genField maxBytes = Gen.choice
+      [ pure Nothing
+      , Just <$> Gen.bytes (Gen.linear 0 maxBytes)
+      ]
+    buildDataRow :: [Maybe ByteString] -> ByteString
+    buildDataRow fields =
+      let nFields = length fields
+          fieldsBS = BS.concat $ map encodeField fields
+          payload = testEncodeInt16BE (fromIntegral nFields) <> fieldsBS
+          lenVal = fromIntegral (BS.length payload + 4) :: Int32
+      in BS.singleton 68 <> testEncodeInt32BE lenVal <> payload
+    encodeField Nothing = testEncodeInt32BE (-1)
+    encodeField (Just bs) = testEncodeInt32BE (fromIntegral (BS.length bs)) <> bs
+
+testEncodeInt32BE :: Int32 -> ByteString
+testEncodeInt32BE = LBS.toStrict . Builder.toLazyByteString . Builder.int32BE
+
+testEncodeInt16BE :: Int16 -> ByteString
+testEncodeInt16BE = LBS.toStrict . Builder.toLazyByteString . Builder.int16BE
diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs
index a9d3dd6..8c427fe 100644
--- a/hpgsql/src/Hpgsql/Internal.hs
+++ b/hpgsql/src/Hpgsql/Internal.hs
@@ -910,7 +910,7 @@ consumeResults conn qryId = do
           finalStream = case mDataRow of
             Nothing -> allOtherRows
             Just dr ->
-              DataRows dr.rowColumnData `S.cons` allOtherRows
+              DataRows dr.fullDataRow `S.cons` allOtherRows
       pure (mERowDesc, finalStream)
   where
     receiveReadyForQueryIfNecessary :: WeakThreadId -> IO ()
diff --git a/hpgsql/src/Hpgsql/InternalTypes.hs b/hpgsql/src/Hpgsql/InternalTypes.hs
index 7b9534e..af81141 100644
--- a/hpgsql/src/Hpgsql/InternalTypes.hs
+++ b/hpgsql/src/Hpgsql/InternalTypes.hs
@@ -368,7 +368,9 @@ newtype ErrorResponse = ErrorResponse (Map ErrorDetail LBS.ByteString)
 newtype CommandComplete = CommandComplete {numRows :: Int64}
   deriving stock (Show)
 
-newtype DataRow = DataRow {rowColumnData :: ByteString}
+-- | A DataRow with its leading identifying character ('D'), the 32bits self-length,
+-- the 2 bytes for the number of fields and the fields' lengths and values themselves.
+newtype DataRow = DataRow {fullDataRow :: ByteString}
 
 instance Show DataRow where
   show _ = "DataRow"
diff --git a/hpgsql/src/Hpgsql/Msgs.hs b/hpgsql/src/Hpgsql/Msgs.hs
index e19822e..3171079 100644
--- a/hpgsql/src/Hpgsql/Msgs.hs
+++ b/hpgsql/src/Hpgsql/Msgs.hs
@@ -226,7 +226,7 @@ instance FromPgMessage CopyInResponse where
 instance FromPgMessage DataRow where
   msgParser = PgMsgParser $ \c !restOfMsg -> case c of
     -- TODO: Double-check the re-encoding here is correct!
-    'D' -> Just $ DataRow {rowColumnData = BS.singleton 68 <> BinSer.encodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg}
+    'D' -> Just $ DataRow {fullDataRow = BS.singleton 68 <> BinSer.encodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg}
     _ -> Nothing
 
 instance FromPgMessage NoData where

From 253fbd71debfe38b6e7cba9399b71fd22b058815 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 23 Aug 2026 10:28:43 -0300
Subject: [PATCH 08/12] Make `unsafeDecodeWord` a safe function

---
 hpgsql-tests/EncodingDecodingSpec.hs          | 25 +++++++------
 .../src/Hpgsql/Encoding/BinarySerializer.hs   | 37 +++++++++++--------
 2 files changed, 35 insertions(+), 27 deletions(-)

diff --git a/hpgsql-tests/EncodingDecodingSpec.hs b/hpgsql-tests/EncodingDecodingSpec.hs
index 03462c6..33450cb 100644
--- a/hpgsql-tests/EncodingDecodingSpec.hs
+++ b/hpgsql-tests/EncodingDecodingSpec.hs
@@ -43,8 +43,8 @@ import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Gen
 import Hpgsql
 import Hpgsql.Connection (ConnectOpts (..), connect, connectOpts, defaultConnectOpts, refreshTypeInfoCache, withConnectionOpts)
-import Hpgsql.InternalTypes (DataRow (..))
 import Hpgsql.Encoding (EncodingContext (..), FieldDecoder (..), FieldEncoder (..), FieldInfo (..), FromPgField (..), FromPgRow (..), LowerCasedPgEnum (..), RowEncoder (..), ToPgField (..), ToPgRow (..), compositeTypeDecoder, compositeTypeEncoder, nullableField, rawBytesFieldDecoder, singleField, typeFieldDecoder, typeFieldEncoder, typeMustBeNamed, typeOidWithName)
+import Hpgsql.InternalTypes (DataRow (..))
 import Hpgsql.Pipeline (pipeline, pipelineWith, runPipeline)
 import Hpgsql.Query (mkQuery, sql, vALUES)
 import Hpgsql.Time (Unbounded (..))
@@ -881,11 +881,13 @@ data Person = Person {name :: Text, born :: Day, heightMeters :: Double}
 specializedDataRowDecodingConsistency :: PropertyT IO ()
 specializedDataRowDecodingConsistency = hedgehog $ do
   dataRows <- Gen.forAll $ Gen.list (Gen.linear 0 20) genDataRowBS
-  mapM_ (\drBS -> do
-    let restOfMsg = LBS.fromStrict (BS.drop 5 drBS)
-        parsed = parseDataRowFromPgMsg 'D' restOfMsg
-    fmap fullDataRow parsed === Just drBS
-    ) dataRows
+  mapM_
+    ( \drBS -> do
+        let restOfMsg = LBS.fromStrict (BS.drop 5 drBS)
+            parsed = parseDataRowFromPgMsg 'D' restOfMsg
+        fmap fullDataRow parsed === Just drBS
+    )
+    dataRows
 
 -- | Copy of the FromPgMessage DataRow instance's parsing logic from Hpgsql.Msgs.
 -- Keep in sync with that module's @instance FromPgMessage DataRow@.
@@ -904,17 +906,18 @@ genDataRowBS = do
   fields <- replicateM numFields (genField maxPerField)
   pure $ buildDataRow fields
   where
-    genField maxBytes = Gen.choice
-      [ pure Nothing
-      , Just <$> Gen.bytes (Gen.linear 0 maxBytes)
-      ]
+    genField maxBytes =
+      Gen.choice
+        [ pure Nothing,
+          Just <$> Gen.bytes (Gen.linear 0 maxBytes)
+        ]
     buildDataRow :: [Maybe ByteString] -> ByteString
     buildDataRow fields =
       let nFields = length fields
           fieldsBS = BS.concat $ map encodeField fields
           payload = testEncodeInt16BE (fromIntegral nFields) <> fieldsBS
           lenVal = fromIntegral (BS.length payload + 4) :: Int32
-      in BS.singleton 68 <> testEncodeInt32BE lenVal <> payload
+       in BS.singleton 68 <> testEncodeInt32BE lenVal <> payload
     encodeField Nothing = testEncodeInt32BE (-1)
     encodeField (Just bs) = testEncodeInt32BE (fromIntegral (BS.length bs)) <> bs
 
diff --git a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
index 35b50fe..cfaa2c8 100644
--- a/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
+++ b/hpgsql/src/Hpgsql/Encoding/BinarySerializer.hs
@@ -62,15 +62,20 @@ fromBigEndian16 = Prelude.id
 fromBigEndian16 = byteSwap16
 #endif
 
-{-# INLINE unsafeDecodeWord #-}
-unsafeDecodeWord :: (Storable a) => ByteStringIdx -> ByteString -> Int -> (a -> a) -> Either String a
-unsafeDecodeWord idx (InternalBS.BS bytesPtr len) minLen endianConvert =
-  if len >= minLen + idx.idx
-    then
-      -- A bang (strictness) in `decodedWord` makes our benchmarks allocate more memory and run slower!
-      let decodedWord = endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
-       in Right decodedWord
-    else Left "Less than enough bytes to decode"
+data CoolWordDec a where
+  CWord8 :: CoolWordDec Word8
+  CWord16 :: CoolWordDec Word16
+  CWord32 :: CoolWordDec Word32
+  CWord64 :: CoolWordDec Word64
+
+{-# INLINE decodeWord #-}
+decodeWord :: CoolWordDec a -> ByteStringIdx -> ByteString -> (a -> a) -> Either String a
+decodeWord wdec idx (InternalBS.BS bytesPtr len) endianConvert =
+  case wdec of
+    CWord8 -> if len < 1 + idx.idx then Left "Less than enough bytes to decode" else Right $ endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
+    CWord16 -> if len < 2 + idx.idx then Left "Less than enough bytes to decode" else Right $ endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
+    CWord32 -> if len < 4 + idx.idx then Left "Less than enough bytes to decode" else Right $ endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
+    CWord64 -> if len < 8 + idx.idx then Left "Less than enough bytes to decode" else Right $ endianConvert $ unsafeDupablePerformIO $ withForeignPtr bytesPtr $ \ptr -> peekByteOff (coerce ptr) idx.idx
 
 {-# INLINE unsafeEncodeWord #-}
 unsafeEncodeWord :: (Storable a) => a -> (a -> a) -> Int -> ByteString
@@ -83,7 +88,7 @@ newtype ByteStringIdx = ByteStringIdx {idx :: Int}
 
 {-# INLINE decodeInt16BE #-}
 decodeInt16BE :: ByteStringIdx -> ByteString -> Either String Int16
-decodeInt16BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 2 fromBigEndian16
+decodeInt16BE idx bs = fromIntegral <$> decodeWord CWord16 idx bs fromBigEndian16
 
 {-# INLINE encodeInt16BE #-}
 encodeInt16BE :: Int16 -> ByteString
@@ -91,19 +96,19 @@ encodeInt16BE n = unsafeEncodeWord (fromIntegral n) fromBigEndian16 2
 
 {-# INLINE decodeWord8 #-}
 decodeWord8 :: ByteStringIdx -> ByteString -> Either String Word8
-decodeWord8 idx bs = unsafeDecodeWord idx bs 1 Prelude.id
+decodeWord8 idx bs = decodeWord CWord8 idx bs Prelude.id
 
 {-# INLINE decodeWord32BE #-}
 decodeWord32BE :: ByteString -> Either String Word32
-decodeWord32BE bs = unsafeDecodeWord 0 bs 4 fromBigEndian32
+decodeWord32BE bs = decodeWord CWord32 0 bs fromBigEndian32
 
 {-# INLINE decodeWord64BE #-}
 decodeWord64BE :: ByteString -> Either String Word64
-decodeWord64BE bs = unsafeDecodeWord 0 bs 8 fromBigEndian64
+decodeWord64BE bs = decodeWord CWord64 0 bs fromBigEndian64
 
 {-# INLINE decodeInt32BE #-}
 decodeInt32BE :: ByteStringIdx -> ByteString -> Either String Int32
-decodeInt32BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 4 fromBigEndian32
+decodeInt32BE idx bs = fromIntegral <$> decodeWord CWord32 idx bs fromBigEndian32
 
 {-# INLINE encodeInt32BE #-}
 encodeInt32BE :: Int32 -> ByteString
@@ -111,7 +116,7 @@ encodeInt32BE n = unsafeEncodeWord (fromIntegral n) fromBigEndian32 4
 
 {-# INLINE decodeInt64BE #-}
 decodeInt64BE :: ByteStringIdx -> ByteString -> Either String Int64
-decodeInt64BE idx bs = fromIntegral <$> unsafeDecodeWord idx bs 8 fromBigEndian64
+decodeInt64BE idx bs = fromIntegral <$> decodeWord CWord64 idx bs fromBigEndian64
 
 {-# INLINE encodeInt64BE #-}
 encodeInt64BE :: Int64 -> ByteString
@@ -142,7 +147,7 @@ decodeDataRow idx bs@(InternalBS.BS _bytesPtr len) =
   -- Whether this is worth keeping is sort of questionable. It's complex
   -- (even if I think it's safe and well tested) and reduces runtime of one of
   -- our benchmarks by 2% compared to not having it.
-  case unsafeDecodeWord idx bs 8 fromBigEndian64 of
+  case decodeWord CWord64 idx bs fromBigEndian64 of
     Right (w64 :: Word64) ->
       -- After fromBigEndian64, the Word64 has bytes in big-endian order:
       -- byte 0 (msg type) in MSB, bytes 1-4 (length) next, bytes 5-6 (col count), byte 7 in LSB.

From d601a434acc87ffd4d6731a20a4776247d104304 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 23 Aug 2026 14:30:18 -0300
Subject: [PATCH 09/12] Update benchmarks

---
 BENCHMARKS.md | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/BENCHMARKS.md b/BENCHMARKS.md
index 474bf7c..b2f08e1 100644
--- a/BENCHMARKS.md
+++ b/BENCHMARKS.md
@@ -31,18 +31,18 @@ This runs with 2 concurrent queries, 10 times over:
 
 This benchmark is unfair towards both hpgsql and postgresql-simple because the row decoder is Generically derived for them while it is hand-written for hasql.
 ```csv
-postgresql-simple Record List (100000 rows),12.23,142.52M,91.3
-hasql Record List (100000 rows),6.119,142.48M,78.5
-hpgsql Record List (100000 rows),3.719,72.07M,120.2
+postgresql-simple Record List (100000 rows),11.69,143.04M,91.9
+hasql Record List (100000 rows),6.086,142.48M,80.2
+hpgsql Record List (100000 rows),3.548,72.07M,119.9
 ```
 
 ### Materializing 100_000 rows with 13 columns each into a List of Tuples
 
 This runs with 2 concurrent queries, 10 times over:
 ```csv
-postgresql-simple Tuple List (100000 rows),14.37,142.54M,137.7
-hasql Tuple List (100000 rows),8.305,142.48M,201.3
-hpgsql Tuple List (100000 rows),4.541,72.07M,150.5
+postgresql-simple Tuple List (100000 rows),14.31,143.18M,144.9
+hasql Tuple List (100000 rows),8.769,142.48M,203.9
+hpgsql Tuple List (100000 rows),4.256,72.07M,150.4
 ```
 
 ### Streaming 100_000 rows with 13 columns as Records
@@ -55,9 +55,9 @@ However, Hpgsql's implementation streams directly from the socket while the othe
 it might not be a fair comparison in terms of implementation (e.g. you can advance multiple
 cursors simultaneously, but not hpgsql's Streamed-from-socket streams).
 ```csv
-streaming-postgresql-simple Record Stream (100000 rows),13.05,73.30M,0.0
-postgresql-simple Record fold (100000 rows),12.23,76.22M,0.0
-hpgsql Record Stream (100000 rows),1.117,72.07M,0.0
+streaming-postgresql-simple Record Stream (100000 rows),13.15,73.32M,0.0
+postgresql-simple Record fold (100000 rows),12.58,76.49M,0.0
+hpgsql Record Stream (100000 rows),1.125,72.07M,0.0
 ```
 
 ### Streaming 100_000 rows with 13 columns as Tuples
@@ -67,9 +67,9 @@ Hpgsql's implementation streams directly from the socket while the others use cu
 it might not be a fair comparison in terms of implementation (e.g. you can advance multiple
 cursors simultaneously, but not hpgsql's Streamed-from-socket streams).
 ```csv
-streaming-postgresql-simple Tuple Stream (100000 rows),14.04,73.37M,0.0
-postgresql-simple Tuple fold (100000 rows),13.53,82.45M,0.0
-hpgsql Tuple Stream (100000 rows),880.0,72.07M,0.0
+streaming-postgresql-simple Tuple Stream (100000 rows),13.75,73.23M,0.0
+postgresql-simple Tuple fold (100000 rows),12.60,79.92M,0.0
+hpgsql Tuple Stream (100000 rows),799.7,72.07M,0.0
 ```
 
 ### COPY FROM STDIN
@@ -77,6 +77,6 @@ hpgsql Tuple Stream (100000 rows),880.0,72.07M,0.0
 This compares hpgsql's binary copy to a `forM` loop writing text rows.
 
 ```csv
-postgresql-simple text COPY (100000 rows),1.373,72.10M,3.8
-hpgsql copyFromS binary COPY (100000 rows),652.0,72.07M,10.8
+postgresql-simple text COPY (100000 rows),1.324,72.09M,3.8
+hpgsql copyFromS binary COPY (100000 rows),631.8,72.07M,10.8
 ```

From d61e2b89ae72f1b13299c94f70cb9d358f692484 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 23 Aug 2026 18:53:31 -0300
Subject: [PATCH 10/12] Make `DataRow` rebuilding correct by construction

And delete a test that became unnecessary
---
 hpgsql-tests/EncodingDecodingSpec.hs | 54 ----------------------------
 hpgsql/src/Hpgsql/Internal.hs        | 12 +++----
 hpgsql/src/Hpgsql/Msgs.hs            | 27 +++++++-------
 hpgsql/src/Hpgsql/SimpleParser.hs    |  2 +-
 4 files changed, 20 insertions(+), 75 deletions(-)

diff --git a/hpgsql-tests/EncodingDecodingSpec.hs b/hpgsql-tests/EncodingDecodingSpec.hs
index 33450cb..9fcd34b 100644
--- a/hpgsql-tests/EncodingDecodingSpec.hs
+++ b/hpgsql-tests/EncodingDecodingSpec.hs
@@ -5,7 +5,6 @@ import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Lazy as LBS
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -44,7 +43,6 @@ import qualified Hedgehog.Range as Gen
 import Hpgsql
 import Hpgsql.Connection (ConnectOpts (..), connect, connectOpts, defaultConnectOpts, refreshTypeInfoCache, withConnectionOpts)
 import Hpgsql.Encoding (EncodingContext (..), FieldDecoder (..), FieldEncoder (..), FieldInfo (..), FromPgField (..), FromPgRow (..), LowerCasedPgEnum (..), RowEncoder (..), ToPgField (..), ToPgRow (..), compositeTypeDecoder, compositeTypeEncoder, nullableField, rawBytesFieldDecoder, singleField, typeFieldDecoder, typeFieldEncoder, typeMustBeNamed, typeOidWithName)
-import Hpgsql.InternalTypes (DataRow (..))
 import Hpgsql.Pipeline (pipeline, pipelineWith, runPipeline)
 import Hpgsql.Query (mkQuery, sql, vALUES)
 import Hpgsql.Time (Unbounded (..))
@@ -162,9 +160,6 @@ spec = parallel $ do
   it
     "0-columns results can be decoded"
     zeroColumnsResults
-  it
-    "Specialized DataRow decoding consistency"
-    specializedDataRowDecodingConsistency
 
 zeroColumnsResults :: IO ()
 zeroColumnsResults = do
@@ -877,52 +872,3 @@ valuesTypeRoundTrip conn = hedgehog $ do
 data Person = Person {name :: Text, born :: Day, heightMeters :: Double}
   deriving stock (Generic)
   deriving anyclass (FromPgRow)
-
-specializedDataRowDecodingConsistency :: PropertyT IO ()
-specializedDataRowDecodingConsistency = hedgehog $ do
-  dataRows <- Gen.forAll $ Gen.list (Gen.linear 0 20) genDataRowBS
-  mapM_
-    ( \drBS -> do
-        let restOfMsg = LBS.fromStrict (BS.drop 5 drBS)
-            parsed = parseDataRowFromPgMsg 'D' restOfMsg
-        fmap fullDataRow parsed === Just drBS
-    )
-    dataRows
-
--- | Copy of the FromPgMessage DataRow instance's parsing logic from Hpgsql.Msgs.
--- Keep in sync with that module's @instance FromPgMessage DataRow@.
-parseDataRowFromPgMsg :: Char -> LBS.ByteString -> Maybe DataRow
-parseDataRowFromPgMsg c !restOfMsg = case c of
-  'D' -> Just $ DataRow $ BS.singleton 68 <> testEncodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg
-  _ -> Nothing
-
-genDataRowBS :: Gen.Gen ByteString
-genDataRowBS = do
-  numFields <- Gen.int (Gen.linear 0 10)
-  -- Each NULL field adds 4 bytes overhead (length = -1). Each non-NULL field adds 4 + n bytes.
-  -- A 0-field DataRow is 7 bytes: 1 ('D') + 4 (msg length) + 2 (field count).
-  -- We target a max total of 100 bytes, so 93 bytes are available for fields.
-  let maxPerField = if numFields == 0 then 0 else max 0 ((93 - 4 * numFields) `div` numFields)
-  fields <- replicateM numFields (genField maxPerField)
-  pure $ buildDataRow fields
-  where
-    genField maxBytes =
-      Gen.choice
-        [ pure Nothing,
-          Just <$> Gen.bytes (Gen.linear 0 maxBytes)
-        ]
-    buildDataRow :: [Maybe ByteString] -> ByteString
-    buildDataRow fields =
-      let nFields = length fields
-          fieldsBS = BS.concat $ map encodeField fields
-          payload = testEncodeInt16BE (fromIntegral nFields) <> fieldsBS
-          lenVal = fromIntegral (BS.length payload + 4) :: Int32
-       in BS.singleton 68 <> testEncodeInt32BE lenVal <> payload
-    encodeField Nothing = testEncodeInt32BE (-1)
-    encodeField (Just bs) = testEncodeInt32BE (fromIntegral (BS.length bs)) <> bs
-
-testEncodeInt32BE :: Int32 -> ByteString
-testEncodeInt32BE = LBS.toStrict . Builder.toLazyByteString . Builder.int32BE
-
-testEncodeInt16BE :: Int16 -> ByteString
-testEncodeInt16BE = LBS.toStrict . Builder.toLazyByteString . Builder.int16BE
diff --git a/hpgsql/src/Hpgsql/Internal.hs b/hpgsql/src/Hpgsql/Internal.hs
index 8c427fe..f986b59 100644
--- a/hpgsql/src/Hpgsql/Internal.hs
+++ b/hpgsql/src/Hpgsql/Internal.hs
@@ -538,8 +538,8 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
       lenLeftToFetch :: Int64 = fromIntegral $ either error id (BinSer.decodeInt32BE 0 $ LBS.toStrict lenbs) - 4
       fullMessageLen = 5 + lenLeftToFetch
   (nowBuf, _nowBufLen) <- if initialBufLen >= fullMessageLen then pure (initialBuf, initialBufLen) else receiveUntilBufferHasAtLeast fullMessageLen
-  let restOfMsg = LBS.drop 5 $ LBS.take fullMessageLen nowBuf
-  receivedNoticeOrParameterSoTryAgain <- go msgIdentChar restOfMsg fullMessageLen nowBuf
+  let fullMsg = LBS.take fullMessageLen nowBuf
+  receivedNoticeOrParameterSoTryAgain <- go msgIdentChar fullMsg fullMessageLen nowBuf
   case receivedNoticeOrParameterSoTryAgain of
     Nothing -> receiveNextMsgGeneric conn receiveWhat
     Just res -> pure res
@@ -552,12 +552,12 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
     -- the recvBuffer, then we _must_ remove that message from recvBuffer.
     -- Ideally we'd have non-retriable STM at the type-level here. Maybe later.
     -- Make sure to do very little work inside `go`!
-    go msgIdentChar restOfMsg fullMessageLen nowBuf = mask_ $ modifyIORefIO recvBuffer $ do
+    go msgIdentChar fullMsg fullMessageLen nowBuf = mask_ $ modifyIORefIO recvBuffer $ do
       let bufferWithoutMsg = LBS.drop fullMessageLen nowBuf
           handleUnexpectedMsg onNotAnyReasonableMsg =
             -- This could be a Notification, NOTICE or a ParameterStatus message, since these
             -- can be received _at any time_ according to the docs.
-            case parsePgMessage msgIdentChar restOfMsg (Left3 <$> msgParser @NotificationResponse <|> Middle3 <$> msgParser @NoticeResponse <|> Right3 <$> msgParser @ParameterStatus) of
+            case parsePgMessage msgIdentChar fullMsg (Left3 <$> msgParser @NotificationResponse <|> Middle3 <$> msgParser @NoticeResponse <|> Right3 <$> msgParser @ParameterStatus) of
               Just (Left3 notifResponse) -> do
                 debugPrint "Received notification. Will add it to internal queue."
                 STM.atomically $ do
@@ -579,7 +579,7 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
               Nothing -> do
                 -- Just in case this is a postgres error, it might include useful information,
                 -- so we spit that out
-                let mPgError = mkPostgresError "" <$> parsePgMessage msgIdentChar restOfMsg (msgParser @ErrorResponse)
+                let mPgError = mkPostgresError "" <$> parsePgMessage msgIdentChar fullMsg (msgParser @ErrorResponse)
                 fmap (nowBuf,) $ Just <$> STM.atomically (onNotAnyReasonableMsg (msgIdentChar, mPgError))
       case receiveWhat of
         ReceiveDataRows ->
@@ -592,7 +592,7 @@ receiveNextMsgGeneric conn@HPgConnection {socket, recvBuffer} receiveWhat = do
                   pure (LBS.fromStrict unconsumedBuffer, Just msgs)
                 _ -> handleUnexpectedMsg $ const $ pure "" -- No error when we stop receiving DataRows, only emptiness
         ReceiveArbitraryMsg parser f ->
-          case parsePgMessage msgIdentChar restOfMsg parser of
+          case parsePgMessage msgIdentChar fullMsg parser of
             Just msg -> do
               debugPrint $ "Received " ++ show msg
               fmap (bufferWithoutMsg,) $ Just <$> STM.atomically (f (Right msg))
diff --git a/hpgsql/src/Hpgsql/Msgs.hs b/hpgsql/src/Hpgsql/Msgs.hs
index 3171079..3446e15 100644
--- a/hpgsql/src/Hpgsql/Msgs.hs
+++ b/hpgsql/src/Hpgsql/Msgs.hs
@@ -34,7 +34,7 @@ class ToPgMessage a where
 newtype PgMsgParser a
   = PgMsgParser
       ( Char ->
-        -- \| Message contents after the Int32 length attribute
+        -- \| Full PG message contents, including the message identifier byte, the rest-of-message length and the message contents.
         LBS.ByteString ->
         Maybe a
       )
@@ -137,7 +137,7 @@ data Terminate = Terminate
   deriving stock (Show)
 
 instance FromPgMessage AuthenticationResponse where
-  msgParser = PgMsgParser $ \c restOfMsg -> case c of
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) -> case c of
     'R' -> case first (BinSer.decodeInt32BE 0 . LBS.toStrict) $ LBS.splitAt 4 restOfMsg of
       (Right 0, _) -> Just $ AuthenticationResponse AuthOk
       (Right 2, _) -> Just $ AuthenticationResponse AuthKerberosV5
@@ -154,19 +154,19 @@ instance FromPgMessage AuthenticationResponse where
     _ -> Nothing
 
 instance FromPgMessage BackendKeyData where
-  msgParser = PgMsgParser $ \c (LBS.splitAt 4 -> (pidBS, backendSecretKey)) -> case c of
+  msgParser = PgMsgParser $ \c (LBS.splitAt 4 . LBS.drop 5 -> (pidBS, backendSecretKey)) -> case c of
     'K' -> case BinSer.decodeInt32BE 0 $ LBS.toStrict pidBS of
       Right pid -> Just $ BackendKeyData {backendPid = pid, backendSecretKey = LBS.toStrict backendSecretKey}
       Left _ -> Nothing
     _ -> Nothing
 
 instance FromPgMessage BindComplete where
-  msgParser = PgMsgParser $ \c _restOfMsg -> case c of
+  msgParser = PgMsgParser $ \c _ -> case c of
     '2' -> Just BindComplete
     _ -> Nothing
 
 instance FromPgMessage CommandComplete where
-  msgParser = PgMsgParser $ \c restOfMsg -> case c of
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) -> case c of
     'C' ->
       let astext = decodeASCII $ LBS.toStrict $ LBS.dropEnd 1 restOfMsg
        in case TextParsec.parseOnly ((ins <|> del <|> upd <|> merge <|> sel <|> move <|> fetch <|> copy) <* TextParsec.endOfInput) astext of
@@ -224,9 +224,8 @@ instance FromPgMessage CopyInResponse where
     _ -> Nothing
 
 instance FromPgMessage DataRow where
-  msgParser = PgMsgParser $ \c !restOfMsg -> case c of
-    -- TODO: Double-check the re-encoding here is correct!
-    'D' -> Just $ DataRow {fullDataRow = BS.singleton 68 <> BinSer.encodeInt32BE (fromIntegral $ LBS.length restOfMsg + 4) <> LBS.toStrict restOfMsg}
+  msgParser = PgMsgParser $ \c !fullDataRow -> case c of
+    'D' -> Just $ DataRow {fullDataRow = LBS.toStrict fullDataRow}
     _ -> Nothing
 
 instance FromPgMessage NoData where
@@ -235,7 +234,7 @@ instance FromPgMessage NoData where
     _ -> Nothing
 
 instance FromPgMessage ParameterStatus where
-  msgParser = PgMsgParser $ \c !restOfMsg -> case c of
+  msgParser = PgMsgParser $ \c !(LBS.drop 5 -> restOfMsg) -> case c of
     'S' -> case LazyParsec.parseOnly (((,) <$> nulTerminatedCStringParser <*> nulTerminatedCStringParser) <* Parsec.endOfInput) restOfMsg of
       Left _ -> error "Failed parsing ParameterStatus"
       Right (parameterName, parameterValue) -> Just $ ParameterStatus {..}
@@ -349,14 +348,14 @@ instance ToPgMessage StartupMessage where
         Builder.int32BE (4 + contentsLen) <> contents
 
 instance FromPgMessage ReadyForQuery where
-  msgParser = PgMsgParser $ \c restOfMsg -> case (c, restOfMsg) of
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) -> case (c, restOfMsg) of
     ('Z', "I") -> Just $ ReadyForQuery TransIdle
     ('Z', "T") -> Just $ ReadyForQuery TransInTrans
     ('Z', "E") -> Just $ ReadyForQuery TransInError
     _ -> Nothing
 
 instance FromPgMessage RowDescription where
-  msgParser = PgMsgParser $ \c restOfMsg ->
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) ->
     if c == 'T'
       then
         let (numColsBS, colContents) = LBS.splitAt 2 restOfMsg
@@ -369,7 +368,7 @@ instance FromPgMessage RowDescription where
       else Nothing
 
 instance FromPgMessage ErrorResponse where
-  msgParser = PgMsgParser $ \c restOfMsg ->
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) ->
     if c /= 'E'
       then Nothing
       else
@@ -385,7 +384,7 @@ instance FromPgMessage ErrorResponse where
              in Just $ ErrorResponse $ Map.fromList $ mapMaybe parseSingleErrorField errorFields
 
 instance FromPgMessage NoticeResponse where
-  msgParser = PgMsgParser $ \c restOfMsg ->
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) ->
     if c /= 'N'
       then Nothing
       else
@@ -402,7 +401,7 @@ instance FromPgMessage NoticeResponse where
              in Just $ NoticeResponse $ Map.fromList $ mapMaybe parseSingleErrorField errorFields
 
 instance FromPgMessage NotificationResponse where
-  msgParser = PgMsgParser $ \c restOfMsg ->
+  msgParser = PgMsgParser $ \c (LBS.drop 5 -> restOfMsg) ->
     if c /= 'A'
       then Nothing
       else
diff --git a/hpgsql/src/Hpgsql/SimpleParser.hs b/hpgsql/src/Hpgsql/SimpleParser.hs
index abac6d4..74940f0 100644
--- a/hpgsql/src/Hpgsql/SimpleParser.hs
+++ b/hpgsql/src/Hpgsql/SimpleParser.hs
@@ -102,7 +102,7 @@ take n = Parser $ \idx bs kf ks ->
           -- the field decoder will need to evaluate this anyway,
           -- so no need for an extra thunk
           !h -> ks h (ByteStringIdx skip') bs
-        else kf ("take: wanted " <> show skip' <> " bytes but only " <> show (BS.length bs) <> " remain")
+        else kf "take: insufficient bytes"
 {-# INLINE take #-}
 
 -- | Consume exactly @n@ bytes of input, failing if fewer than @n@ bytes

From 933947e6294ab20ff52a8878801555a99f19b550 Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Sun, 23 Aug 2026 18:54:21 -0300
Subject: [PATCH 11/12] Cleaner GHC Core

---
 hpgsql-tests/RowDecoderGhcCore.hs | 64 +++++++++++++++++++++----------
 1 file changed, 43 insertions(+), 21 deletions(-)

diff --git a/hpgsql-tests/RowDecoderGhcCore.hs b/hpgsql-tests/RowDecoderGhcCore.hs
index e53d8a5..e9f272b 100644
--- a/hpgsql-tests/RowDecoderGhcCore.hs
+++ b/hpgsql-tests/RowDecoderGhcCore.hs
@@ -1,38 +1,60 @@
-{-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}
+{-# OPTIONS_GHC -ddump-simpl -dno-typeable-binds -dsuppress-coercions -dsuppress-module-prefixes -dsuppress-type-applications -ddump-to-file #-}
 
 -- |
 -- This is not a real test module. It's just a type deriving `FromPgRow`
--- so we can look at GHC Core output.
+-- so we can look at GHC Core output. It's as small as we can make it to
+-- facilitate reading GHC Core.
 module RowDecoderGhcCore where
 
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Time (Day, UTCTime)
 import GHC.Generics (Generic)
-import Hpgsql.Encoding (FromPgRow (..), fieldDecoder, genericFromPgRow, singleField)
-
-data BenchRow = BenchRow
-  { brId :: !Int,
-    brDate1 :: !Day,
-    brDate2 :: !Day,
-    brTimestamp1 :: !UTCTime,
-    brTimestamp2 :: !UTCTime,
-    brText1 :: !Text,
-    brText2 :: !Text,
-    brDouble1 :: !Double,
-    brDouble2 :: !Double,
-    brMaybeInt :: !(Maybe Int),
-    brMaybeText :: !(Maybe Text),
-    brMaybeDouble :: !(Maybe Double),
-    brMaybeDay :: !(Maybe Day)
+import Hpgsql.Encoding (FromPgField (..), FromPgRow (..), genericFromPgRow, singleField)
+
+-- | BestCaseScenarioRecord's purpose is to have a very small row decoder in GHC Core
+-- for my own understanding/comprehension of what a RowDecoder gets compiled to
+-- in the best case scenario. Also, we expect one day to maybe reach a fully inlined
+-- row decoder that only peeks at bytes and allocates 3 values per row (one
+-- for each field), plus one `BestCaseScenarioRecord` per row.
+-- In the GHC Core of this module (use `run ghc-core` to output it), it helps to:
+-- - Look for the Record constructor and grep for it to find where the RowDecoder
+--   invokes it, only to find where the RowDecoder is.
+-- - Grep for numbers that exist in the decoders' implementation, such as 8#, 13#, 4#.
+--   These are strong indicators that each decoder was inlined into the RowDecoder.
+-- There still are unnecessary allocations/boxing even with full inlining, but maybe
+-- one day we'll find a way to get rid of all of them.
+data BestCaseScenarioRecord = BestCaseScenarioRecord
+  { bcsId :: !Int,
+    bcsDate :: !Day,
+    bcsText :: !(Maybe Int)
   }
 
+instance FromPgRow BestCaseScenarioRecord where
+  rowDecoder = BestCaseScenarioRecord <$> singleField fieldDecoder <*> singleField fieldDecoder <*> singleField fieldDecoder
+
+-- data BenchRow = BenchRow
+--   { brId :: !Int,
+--     brDate1 :: !Day,
+--     brDate2 :: !Day,
+--     brTimestamp1 :: !UTCTime,
+--     brTimestamp2 :: !UTCTime,
+--     brText1 :: !Text,
+--     brText2 :: !Text,
+--     brDouble1 :: !Double,
+--     brDouble2 :: !Double,
+--     brMaybeInt :: !(Maybe Int),
+--     brMaybeText :: !(Maybe Text),
+--     brMaybeDouble :: !(Maybe Double),
+--     brMaybeDay :: !(Maybe Day)
+--   }
+
 -- Generically deriving section.
 
-deriving instance Generic BenchRow
+-- deriving instance Generic BenchRow
 
-instance FromPgRow BenchRow where
-  rowDecoder = genericFromPgRow
+-- instance FromPgRow BenchRow where
+--   rowDecoder = genericFromPgRow
 
 -- Hand-written applicative style deriving section.
 -- instance FromPgRow BenchRow where

From 98f00868429a4a499ba1ae90e69f12a18ce9e89e Mon Sep 17 00:00:00 2001
From: Marcelo Zabani <mzabani@gmail.com>
Date: Mon, 24 Aug 2026 15:41:34 -0300
Subject: [PATCH 12/12] Undo unnecessary file change

---
 hpgsql-tests/EncodingDecodingSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hpgsql-tests/EncodingDecodingSpec.hs b/hpgsql-tests/EncodingDecodingSpec.hs
index 9fcd34b..37e63cd 100644
--- a/hpgsql-tests/EncodingDecodingSpec.hs
+++ b/hpgsql-tests/EncodingDecodingSpec.hs
@@ -1,6 +1,6 @@
 module EncodingDecodingSpec where
 
-import Control.Monad (join, replicateM, void)
+import Control.Monad (join, void)
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)