spire-protobuf (empty) → 0.1.0.0

raw patch · 12 files changed

+3219/−0 lines, 12 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, hedgehog, process, spire-protobuf, text

Files

• CHANGELOG.md +7/−0
• LICENSE +27/−0
• spire-protobuf.cabal +108/−0
• src/Spire/Protobuf.hs +52/−0
• src/Spire/Protobuf/Decode.hs +325/−0
• src/Spire/Protobuf/Encode.hs +293/−0
• src/Spire/Protobuf/Field.hs +67/−0
• src/Spire/Protobuf/Message.hs +305/−0
• src/Spire/Protobuf/Wire.hs +249/−0
• test/Main.hs +1511/−0
• test/Properties.hs +253/−0
• test/test.proto +22/−0

@@ -0,0 +1,7 @@+# Revision history for spire-protobuf++## 0.1.0.0 -- 2026-04-27++* Initial release. Minimal Protocol Buffers library with zero-copy+  decoding and GHC Generics integration. No code generation, no+  Template Haskell, no external tools.

@@ -0,0 +1,27 @@+Copyright (c) 2024-2026, Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from this+   software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,108 @@+cabal-version:   3.0+name:            spire-protobuf+version:         0.1.0.0+synopsis:        Minimal Protocol Buffers for Haskell, no codegen+category:        Data, Codec+description:+  A fast, minimal protobuf library with zero-copy decoding and GHC+  Generics integration. No code generation, no Template Haskell, no+  external tools.+  .+  Define messages as Haskell records with 'Field' wrappers for field+  numbers, derive 'Generic' and 'ProtoMessage', and get encode/decode+  for free.+  .+  @+  data User = User+    { name  :: Field 1 Text+    , age   :: Field 2 Int32+    , email :: Field 3 (Maybe Text)+    } deriving (Generic, ProtoMessage)+  @+  .+  Key design decisions:+  .+  * Single-pass decoding directly into target type (no intermediate Map)+  * Zero-copy string\/bytes fields (ByteString slices into input buffer)+  * Length-memoizing Builder for correct submessage encoding+  * GHC 9.10 @-finline-generics@ eliminates Generic overhead+  * 4 dependencies: base, bytestring, text, containers++license:         BSD-3-Clause+license-file:    LICENSE+author:          Josh Burgess+maintainer:      Josh Burgess <joshburgess.webdev@gmail.com>+homepage:        https://github.com/joshburgess/acolyte+bug-reports:     https://github.com/joshburgess/acolyte/issues+build-type:      Simple++extra-source-files:+  test/test.proto++extra-doc-files:+  CHANGELOG.md++library+  exposed-modules:+    Spire.Protobuf+    Spire.Protobuf.Wire+    Spire.Protobuf.Encode+    Spire.Protobuf.Decode+    Spire.Protobuf.Field+    Spire.Protobuf.Message++  build-depends:+      base         >= 4.20 && < 5+    , bytestring   >= 0.11 && < 0.13+    , text         >= 2.0  && < 2.2+    , containers   >= 0.6  && < 0.8++  hs-source-dirs: src+  default-language: GHC2024+  default-extensions:+    StrictData+    OverloadedStrings++  ghc-options: -Wall -funbox-strict-fields -finline-generics++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  default-language: GHC2024+  default-extensions:+    StrictData+    OverloadedStrings++  ghc-options: -Wall -rtsopts "-with-rtsopts=-K1K"++  build-depends:+      base         >= 4.20 && < 5+    , spire-protobuf+    , bytestring   >= 0.11 && < 0.13+    , text         >= 2.0  && < 2.2+    , containers   >= 0.6  && < 0.8+    , process      >= 1.6  && < 1.8++test-suite properties+  type: exitcode-stdio-1.0+  main-is: Properties.hs+  hs-source-dirs: test+  default-language: GHC2024+  default-extensions:+    StrictData+    OverloadedStrings++  ghc-options: -Wall++  build-depends:+      base         >= 4.20 && < 5+    , spire-protobuf+    , hedgehog     >= 1.4  && < 1.8+    , bytestring   >= 0.11 && < 0.13+    , text         >= 2.0  && < 2.2+    , containers   >= 0.6  && < 0.8++source-repository head+  type:     git+  location: https://github.com/joshburgess/acolyte.git

@@ -0,0 +1,52 @@+-- | High-performance Protocol Buffers for Haskell.+--+-- Define messages as Haskell records with 'Field' wrappers for field+-- numbers, derive 'Generic' and 'ProtoMessage', and get encode\/decode+-- for free:+--+-- @+-- data User = User+--   { name  :: Field 1 Text+--   , age   :: Field 2 Int32+--   , email :: Field 3 (Maybe Text)+--   } deriving (Generic)+--+-- instance ProtoMessage User+--+-- -- Encode:+-- let bs = encode (User (Field "Alice") (Field 30) (Field (Just "alice\@example.com")))+--+-- -- Decode:+-- case decode bs of+--   Right user -> print user+--   Left err   -> error (show err)+-- @+module Spire.Protobuf+  ( -- * Messages+    ProtoMessage (..)+  , encode+  , decode+    -- * Field wrapper+  , Field (..)+    -- * Signed integer wrappers (zigzag encoding)+  , SInt32 (..)+  , SInt64 (..)+    -- * Proto3 map fields+  , ProtoMap (..)+    -- * Errors+  , DecodeError (..)+    -- * Re-exports for advanced use+  , ProtoEncode (..)+  , ProtoDecode (..)+  , decodePacked+  , DecodeRepeatedEntry (..)+  , ProtoDefault (..)+  , ProtoBuilder+  , WireType (..)+  ) where++import Spire.Protobuf.Wire (WireType (..))+import Spire.Protobuf.Field (Field (..), SInt32(..), SInt64(..), ProtoMap(..))+import Spire.Protobuf.Encode (ProtoEncode (..), ProtoBuilder, ProtoDefault (..))+import Spire.Protobuf.Decode (ProtoDecode (..), DecodeError (..), decodePacked, DecodeRepeatedEntry(..))+import Spire.Protobuf.Message (ProtoMessage (..), encode, decode)

@@ -0,0 +1,325 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Protobuf decoding: single-pass wire format parser.+--+-- Provides 'ProtoDecode' for individual value types and 'DecodeError'+-- for structured error reporting. The decoder works directly on strict+-- 'ByteString' with zero-copy slicing for bytes/string fields.+module Spire.Protobuf.Decode+  ( -- * ProtoDecode class+    ProtoDecode (..)+    -- * Raw field parsing+  , RawField (..)+  , parseFields+    -- * Packed repeated field decoding+  , decodePacked+    -- * Packed/unpacked repeated entry decoding (Generics support)+  , DecodeRepeatedEntry (..)+    -- * Errors+  , DecodeError (..)+  ) where++import Data.Bits ((.&.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Int (Int32, Int64)+import Data.Text (Text)+import qualified Data.Text.Encoding as TE+import Data.Word (Word32, Word64)+import GHC.Float (castWord32ToFloat, castWord64ToDouble)++import Spire.Protobuf.Wire+import Spire.Protobuf.Field (SInt32(..), SInt64(..))+++-- ===================================================================+-- Errors+-- ===================================================================++-- | Errors that can occur during protobuf decoding.+data DecodeError+  = UnexpectedWireType !Int !WireType !WireType+    -- ^ field number, expected wire type, actual wire type+  | TruncatedInput+    -- ^ input ended before a complete value could be read+  | InvalidVarint+    -- ^ varint encoding was malformed or overflowed+  | InvalidUtf8+    -- ^ a string field contained invalid UTF-8+  | InvalidWireType !Int+    -- ^ wire type id was not one of 0, 1, 2, 5+  deriving (Show, Eq)+++-- ===================================================================+-- Raw field representation+-- ===================================================================++-- | A raw (unparsed) field value as it appears on the wire.+-- Used as an intermediate representation during decoding: parse all+-- tag-value pairs first, then interpret each field.+data RawField+  = RawVarint   !Word64+  | RawFixed64  !Word64+  | RawFixed32  !Word32+  | RawBytes    !ByteString   -- ^ zero-copy slice of the input+  deriving (Show, Eq)+++-- | Parse all tag-value pairs from a protobuf message.+-- Returns a list of (field_number, raw_value) pairs in wire order.+-- Unknown wire types cause a 'Left' error; otherwise parsing is+-- lenient (unknown field numbers are preserved).+parseFields :: ByteString -> Either DecodeError [(Int, RawField)]+parseFields = go []+  where+    go !acc bs+      | BS.null bs = Right (reverse acc)+      | otherwise = case decodeTag bs of+          Nothing ->+            -- Distinguish truncated input from invalid wire type+            case decodeVarint bs of+              Nothing -> Left TruncatedInput+              Just (val, _) ->+                let wireId = fromIntegral (val .&. 0x07) :: Int+                in if wireId `elem` [0, 1, 2, 5]+                   then Left TruncatedInput+                   else Left (InvalidWireType wireId)+          Just (fieldNum, wt, rest) -> case parseRawField wt rest of+            Nothing  -> Left TruncatedInput+            Just (raw, rest') -> go ((fieldNum, raw) : acc) rest'++-- | Parse a raw field value given its wire type.+parseRawField :: WireType -> ByteString -> Maybe (RawField, ByteString)+parseRawField WireVarint bs = do+  (val, rest) <- decodeVarint bs+  Just (RawVarint val, rest)+parseRawField WireFixed64 bs = do+  (val, rest) <- decodeFixed64 bs+  Just (RawFixed64 val, rest)+parseRawField WireFixed32 bs = do+  (val, rest) <- decodeFixed32 bs+  Just (RawFixed32 val, rest)+parseRawField WireLengthDelimited bs = do+  (val, rest) <- decodeLengthDelimited bs+  Just (RawBytes val, rest)+++-- ===================================================================+-- ProtoDecode class+-- ===================================================================++-- | Class for types that can be decoded from a raw protobuf field.+class ProtoDecode a where+  -- | Decode a value from a 'RawField'.+  protoDecodeValue :: RawField -> Either DecodeError a++-- Int32: varint+instance ProtoDecode Int32 where+  protoDecodeValue (RawVarint w) = Right (fromIntegral w :: Int32)+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- Int64: varint+instance ProtoDecode Int64 where+  protoDecodeValue (RawVarint w) = Right (fromIntegral w :: Int64)+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- Word32: varint+instance ProtoDecode Word32 where+  protoDecodeValue (RawVarint w) = Right (fromIntegral w :: Word32)+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- Word64: varint+instance ProtoDecode Word64 where+  protoDecodeValue (RawVarint w) = Right w+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- Bool: varint, 0 = False, nonzero = True+instance ProtoDecode Bool where+  protoDecodeValue (RawVarint w) = Right (w /= 0)+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- Float: fixed32+instance ProtoDecode Float where+  protoDecodeValue (RawFixed32 w) =+    Right (castWord32ToFloat w)+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireFixed32 WireVarint)+  {-# INLINE protoDecodeValue #-}++-- Double: fixed64+instance ProtoDecode Double where+  protoDecodeValue (RawFixed64 w) =+    Right (castWord64ToDouble w)+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireFixed64 WireVarint)+  {-# INLINE protoDecodeValue #-}++-- Text: length-delimited, UTF-8 decoded+instance ProtoDecode Text where+  protoDecodeValue (RawBytes bs) =+    case TE.decodeUtf8' bs of+      Left _  -> Left InvalidUtf8+      Right t -> Right t+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)+  {-# INLINE protoDecodeValue #-}++-- ByteString: length-delimited, zero-copy slice+instance ProtoDecode ByteString where+  protoDecodeValue (RawBytes bs) = Right bs+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)+  {-# INLINE protoDecodeValue #-}++-- SInt32: varint with zigzag decoding+instance ProtoDecode SInt32 where+  protoDecodeValue (RawVarint w) =+    Right (SInt32 (fromIntegral (zigzagDecode w)))+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}++-- SInt64: varint with zigzag decoding+instance ProtoDecode SInt64 where+  protoDecodeValue (RawVarint w) =+    Right (SInt64 (zigzagDecode w))+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireVarint WireLengthDelimited)+  {-# INLINE protoDecodeValue #-}+++-- ===================================================================+-- Packed repeated field decoding+-- ===================================================================++-- | Decode packed repeated scalar values from a 'RawBytes' blob.+-- In proto3, repeated scalar fields may be encoded as a single+-- length-delimited blob containing all values concatenated.+-- Returns 'Left' if the blob cannot be fully consumed.+decodePacked :: ProtoDecode a => (ByteString -> Maybe (a, ByteString)) -> RawField -> Either DecodeError [a]+decodePacked parser (RawBytes bs) = go bs []+  where+    go remaining acc+      | BS.null remaining = Right (reverse acc)+      | otherwise = case parser remaining of+          Just (val, rest) -> go rest (val : acc)+          Nothing -> Left TruncatedInput+decodePacked _ _ = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)+++-- ===================================================================+-- DecodeRepeatedEntry: handles both packed and unpacked entries+-- ===================================================================++-- | Decode a single raw field entry as one or more values of type @a@.+--+-- For packable scalar types (Int32, Int64, Word32, Word64, Bool, Float,+-- Double, SInt32, SInt64), a 'RawBytes' entry is treated as a packed+-- blob containing multiple concatenated values. For non-packable types+-- (Text, ByteString, submessages), 'RawBytes' is decoded as a single+-- value.+--+-- This class is used by the Generics decoder for repeated fields to+-- transparently handle both packed and unpacked wire encodings.+class DecodeRepeatedEntry a where+  decodeRepeatedEntry :: RawField -> Either DecodeError [a]++-- | Default: non-packable types. Decode as a single value.+instance {-# OVERLAPPABLE #-} ProtoDecode a => DecodeRepeatedEntry a where+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++-- Varint-based packable scalars: Int32, Int64, Word32, Word64, Bool++instance DecodeRepeatedEntry Int32 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++instance DecodeRepeatedEntry Int64 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++instance DecodeRepeatedEntry Word32 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++instance DecodeRepeatedEntry Word64 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++instance DecodeRepeatedEntry Bool where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++-- Fixed32-based: Float+instance DecodeRepeatedEntry Float where+  decodeRepeatedEntry (RawBytes bs) = unpackFixed32s bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++-- Fixed64-based: Double+instance DecodeRepeatedEntry Double where+  decodeRepeatedEntry (RawBytes bs) = unpackFixed64s bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++-- Varint-based with zigzag: SInt32, SInt64+instance DecodeRepeatedEntry SInt32 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}++instance DecodeRepeatedEntry SInt64 where+  decodeRepeatedEntry (RawBytes bs) = unpackVarints bs+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}+++-- ===================================================================+-- Unpacking helpers+-- ===================================================================++-- | Unpack varints from a packed blob, decoding each via 'ProtoDecode'.+unpackVarints :: ProtoDecode a => ByteString -> Either DecodeError [a]+unpackVarints = go []+  where+    go !acc bs+      | BS.null bs = Right (reverse acc)+      | otherwise = case decodeVarint bs of+          Just (w, rest) -> case protoDecodeValue (RawVarint w) of+            Right val -> go (val : acc) rest+            Left err  -> Left err+          Nothing -> Left TruncatedInput+{-# INLINE unpackVarints #-}++-- | Unpack fixed32 values from a packed blob.+unpackFixed32s :: ProtoDecode a => ByteString -> Either DecodeError [a]+unpackFixed32s = go []+  where+    go !acc bs+      | BS.null bs = Right (reverse acc)+      | otherwise = case decodeFixed32 bs of+          Just (w, rest) -> case protoDecodeValue (RawFixed32 w) of+            Right val -> go (val : acc) rest+            Left err  -> Left err+          Nothing -> Left TruncatedInput+{-# INLINE unpackFixed32s #-}++-- | Unpack fixed64 values from a packed blob.+unpackFixed64s :: ProtoDecode a => ByteString -> Either DecodeError [a]+unpackFixed64s = go []+  where+    go !acc bs+      | BS.null bs = Right (reverse acc)+      | otherwise = case decodeFixed64 bs of+          Just (w, rest) -> case protoDecodeValue (RawFixed64 w) of+            Right val -> go (val : acc) rest+            Left err  -> Left err+          Nothing -> Left TruncatedInput+{-# INLINE unpackFixed64s #-}

@@ -0,0 +1,293 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Length-memoizing builder and encoding for protobuf values.+--+-- The key insight: protobuf submessages need their byte length encoded+-- as a varint /before/ the content. A normal 'Builder' doesn't know its+-- length until materialized. 'ProtoBuilder' tracks the byte count+-- alongside the builder, so submessage encoding is a single pass.+module Spire.Protobuf.Encode+  ( -- * Length-memoizing Builder+    ProtoBuilder (..)+  , runProtoBuilder+  , pbEmpty+    -- * ProtoEncode class+  , ProtoEncode (..)+    -- * Field encoding+  , encodeField+  , encodeOptionalField+  , encodeRepeatedField+  , encodePackedField+    -- * Submessage encoding+  , encodeSubmessage+    -- * Tag encoding (for advanced use)+  , pbTag+    -- * Proto3 default values+  , ProtoDefault (..)+  ) where++import Data.Bits (shiftL, (.|.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as BEx+import qualified Data.ByteString.Lazy as LBS+import Data.Int (Int32, Int64)+import Data.Text (Text)+import qualified Data.Text.Encoding as TE+import Data.Word (Word32, Word64)+import GHC.TypeLits (KnownNat, natVal)+import Data.Proxy (Proxy(..))++import Spire.Protobuf.Wire+import Spire.Protobuf.Field+++-- ===================================================================+-- ProtoBuilder+-- ===================================================================++-- | A 'Builder' paired with its exact byte length.+--+-- This is needed for submessage encoding: protobuf length-delimited+-- fields require the byte count as a varint prefix. Tracking it+-- incrementally avoids a double-pass.+data ProtoBuilder = ProtoBuilder+  { pbLength  :: {-# UNPACK #-} !Int+  , pbBuilder :: !B.Builder+  }++instance Semigroup ProtoBuilder where+  ProtoBuilder l1 b1 <> ProtoBuilder l2 b2 =+    ProtoBuilder (l1 + l2) (b1 <> b2)+  {-# INLINE (<>) #-}++instance Monoid ProtoBuilder where+  mempty = ProtoBuilder 0 mempty+  {-# INLINE mempty #-}++-- | Empty builder.+pbEmpty :: ProtoBuilder+pbEmpty = mempty+{-# INLINE pbEmpty #-}++-- | Materialize a 'ProtoBuilder' into a strict 'ByteString'.+-- Uses 'safeStrategy' with the exact known length for a single allocation.+runProtoBuilder :: ProtoBuilder -> ByteString+runProtoBuilder (ProtoBuilder len bld) =+  LBS.toStrict (BEx.toLazyByteStringWith+    (BEx.safeStrategy len BEx.smallChunkSize)+    LBS.empty+    bld)+{-# INLINE runProtoBuilder #-}+++-- ===================================================================+-- Helpers: wrap Wire primitives as ProtoBuilder+-- ===================================================================++-- | Encode a varint as a 'ProtoBuilder'.+pbVarint :: Word64 -> ProtoBuilder+pbVarint n = ProtoBuilder (varintSize n) (encodeVarint n)+{-# INLINE pbVarint #-}++-- | Number of bytes a varint takes on the wire.+varintSize :: Word64 -> Int+varintSize n+  | n < 0x80       = 1+  | n < 0x4000     = 2+  | n < 0x200000   = 3+  | n < 0x10000000 = 4+  | n < 0x0800000000 = 5+  | n < 0x040000000000 = 6+  | n < 0x02000000000000 = 7+  | n < 0x0100000000000000 = 8+  | n < 0x8000000000000000 = 9+  | otherwise = 10+{-# INLINE varintSize #-}++-- | Encode a tag as a 'ProtoBuilder'.+pbTag :: Int -> WireType -> ProtoBuilder+pbTag fieldNum wt =+  let tagVal = fromIntegral fieldNum `shiftL` 3 .|. wireTypeToWord wt+  in pbVarint tagVal+{-# INLINE pbTag #-}++wireTypeToWord :: WireType -> Word64+wireTypeToWord WireVarint          = 0+wireTypeToWord WireFixed64         = 1+wireTypeToWord WireLengthDelimited = 2+wireTypeToWord WireFixed32         = 5+{-# INLINE wireTypeToWord #-}++-- | Encode raw bytes as a 'ProtoBuilder'.+pbBytes :: ByteString -> ProtoBuilder+pbBytes bs = ProtoBuilder (BS.length bs) (B.byteString bs)+{-# INLINE pbBytes #-}+++-- ===================================================================+-- ProtoEncode class+-- ===================================================================++-- | Class for types that can be encoded into protobuf wire format.+class ProtoEncode a where+  -- | The wire type used for this value.+  protoWireType :: WireType+  -- | Encode the value (without a tag prefix).+  protoEncodeValue :: a -> ProtoBuilder++-- Int32: varint encoding (cast to Word64 preserving bit pattern)+instance ProtoEncode Int32 where+  protoWireType = WireVarint+  protoEncodeValue n = pbVarint (fromIntegral n :: Word64)+  {-# INLINE protoEncodeValue #-}++-- Int64: varint encoding+instance ProtoEncode Int64 where+  protoWireType = WireVarint+  protoEncodeValue n = pbVarint (fromIntegral n :: Word64)+  {-# INLINE protoEncodeValue #-}++-- Word32: varint encoding+instance ProtoEncode Word32 where+  protoWireType = WireVarint+  protoEncodeValue n = pbVarint (fromIntegral n)+  {-# INLINE protoEncodeValue #-}++-- Word64: varint encoding+instance ProtoEncode Word64 where+  protoWireType = WireVarint+  protoEncodeValue = pbVarint+  {-# INLINE protoEncodeValue #-}++-- Bool: varint 0 or 1+instance ProtoEncode Bool where+  protoWireType = WireVarint+  protoEncodeValue b = pbVarint (if b then 1 else 0)+  {-# INLINE protoEncodeValue #-}++-- Float: fixed32+instance ProtoEncode Float where+  protoWireType = WireFixed32+  protoEncodeValue f = ProtoBuilder 4 (encodeProtoFloat f)+  {-# INLINE protoEncodeValue #-}++-- Double: fixed64+instance ProtoEncode Double where+  protoWireType = WireFixed64+  protoEncodeValue d = ProtoBuilder 8 (encodeProtoDouble d)+  {-# INLINE protoEncodeValue #-}++-- Text: length-delimited UTF-8+instance ProtoEncode Text where+  protoWireType = WireLengthDelimited+  protoEncodeValue t =+    let bs = TE.encodeUtf8 t+        len = BS.length bs+    in pbVarint (fromIntegral len) <> pbBytes bs+  {-# INLINE protoEncodeValue #-}++-- ByteString: length-delimited raw bytes+instance ProtoEncode ByteString where+  protoWireType = WireLengthDelimited+  protoEncodeValue bs =+    let len = BS.length bs+    in pbVarint (fromIntegral len) <> pbBytes bs+  {-# INLINE protoEncodeValue #-}++-- SInt32: varint with zigzag encoding+instance ProtoEncode SInt32 where+  protoWireType = WireVarint+  protoEncodeValue (SInt32 n) = pbVarint (zigzagEncode (fromIntegral n))+  {-# INLINE protoEncodeValue #-}++-- SInt64: varint with zigzag encoding+instance ProtoEncode SInt64 where+  protoWireType = WireVarint+  protoEncodeValue (SInt64 n) = pbVarint (zigzagEncode n)+  {-# INLINE protoEncodeValue #-}+++-- ===================================================================+-- Submessage encoding+-- ===================================================================++-- | Encode a pre-built submessage as a length-delimited value.+-- Prepends the byte length as a varint.+encodeSubmessage :: ProtoBuilder -> ProtoBuilder+encodeSubmessage (ProtoBuilder len bld) =+  let lenPb = pbVarint (fromIntegral len)+  in lenPb <> ProtoBuilder len bld+{-# INLINE encodeSubmessage #-}+++-- ===================================================================+-- Field encoding+-- ===================================================================++-- | Encode a single field: tag + value.+-- Proto3 semantics: skips the field if the value is the default.+encodeField :: forall n a. (KnownNat n, ProtoEncode a, Eq a, ProtoDefault a)+            => Field n a -> ProtoBuilder+encodeField (Field val)+  | val == protoDefault = mempty+  | otherwise =+    let fn = fromIntegral (natVal (Proxy @n)) :: Int+        tag = pbTag fn (protoWireType @a)+    in tag <> protoEncodeValue val+{-# INLINE encodeField #-}++-- | Encode an optional field ('Maybe' wrapper).+-- 'Nothing' encodes to zero bytes. 'Just' encodes like a regular field.+encodeOptionalField :: forall n a. (KnownNat n, ProtoEncode a)+                    => Field n (Maybe a) -> ProtoBuilder+encodeOptionalField (Field Nothing)  = mempty+encodeOptionalField (Field (Just val)) =+  let fn = fromIntegral (natVal (Proxy @n)) :: Int+      tag = pbTag fn (protoWireType @a)+  in tag <> protoEncodeValue val+{-# INLINE encodeOptionalField #-}++-- | Encode a repeated (non-packed) field: each element gets its own tag.+encodeRepeatedField :: forall n a. (KnownNat n, ProtoEncode a)+                    => Field n [a] -> ProtoBuilder+encodeRepeatedField (Field xs) =+  let fn = fromIntegral (natVal (Proxy @n)) :: Int+      tag = pbTag fn (protoWireType @a)+  in foldMap (\v -> tag <> protoEncodeValue v) xs+{-# INLINE encodeRepeatedField #-}++-- | Encode a packed repeated field: one length-delimited blob containing+-- all elements concatenated (only valid for scalar numeric types).+encodePackedField :: forall n a. (KnownNat n, ProtoEncode a)+                  => Field n [a] -> ProtoBuilder+encodePackedField (Field []) = mempty+encodePackedField (Field xs) =+  let fn = fromIntegral (natVal (Proxy @n)) :: Int+      tag = pbTag fn WireLengthDelimited+      content = foldMap protoEncodeValue xs+  in tag <> encodeSubmessage content+{-# INLINE encodePackedField #-}+++-- ===================================================================+-- Proto3 default values+-- ===================================================================++-- | Default values for proto3 field types.+-- In proto3, fields with the default value are omitted from the wire.+class ProtoDefault a where+  protoDefault :: a++instance ProtoDefault Int32  where protoDefault = 0+instance ProtoDefault Int64  where protoDefault = 0+instance ProtoDefault Word32 where protoDefault = 0+instance ProtoDefault Word64 where protoDefault = 0+instance ProtoDefault Bool   where protoDefault = False+instance ProtoDefault Float  where protoDefault = 0.0+instance ProtoDefault Double where protoDefault = 0.0+instance ProtoDefault Text   where protoDefault = ""+instance ProtoDefault ByteString where protoDefault = BS.empty+instance ProtoDefault SInt32 where protoDefault = SInt32 0+instance ProtoDefault SInt64 where protoDefault = SInt64 0

@@ -0,0 +1,67 @@+-- | Type-level field numbers for protobuf messages.+--+-- The 'Field' newtype embeds a compile-time field number (proto3 field tag)+-- into the type. At runtime it is a zero-cost wrapper (via 'coerce').+--+-- @+-- data User = User+--   { name :: Field 1 Text+--   , age  :: Field 2 Int32+--   }+-- @+module Spire.Protobuf.Field+  ( Field (..)+  , fieldVal+    -- * Signed integer wrappers (zigzag encoding)+  , SInt32 (..)+  , SInt64 (..)+    -- * Proto3 map fields+  , ProtoMap (..)+  ) where++import Data.Int (Int32, Int64)+import Data.Map.Strict (Map)+import GHC.TypeLits (Nat, KnownNat, natVal)+import Data.Proxy (Proxy(..))++-- | A protobuf field with a compile-time field number.+--+-- The field number is used for wire encoding; at runtime, 'Field' is+-- just a newtype wrapper (zero overhead via coerce).+newtype Field (n :: Nat) a = Field { unField :: a }+  deriving (Show, Eq, Ord, Functor)++-- | Get the field number at runtime.+fieldVal :: forall n a. KnownNat n => Field n a -> Int+fieldVal _ = fromIntegral (natVal (Proxy @n))+{-# INLINE fieldVal #-}+++-- | Signed 32-bit integer using zigzag encoding on the wire.+-- Use for fields declared as @sint32@ in .proto files.+-- Zigzag encoding maps small-magnitude values (positive or negative)+-- to small varints, unlike plain @int32@ which uses 10 bytes for negatives.+newtype SInt32 = SInt32 { unSInt32 :: Int32 }+  deriving (Show, Eq, Ord)++-- | Signed 64-bit integer using zigzag encoding on the wire.+-- Use for fields declared as @sint64@ in .proto files.+newtype SInt64 = SInt64 { unSInt64 :: Int64 }+  deriving (Show, Eq, Ord)+++-- | Proto3 map field: @map\<K, V\>@.+--+-- On the wire, a map is encoded as a repeated message where each entry+-- has field 1 = key and field 2 = value. This newtype wraps 'Map' and+-- provides the correct protobuf encoding/decoding.+--+-- @+-- data Config = Config+--   { settings :: Field 1 (ProtoMap Text Text)+--   , counts   :: Field 2 (ProtoMap Text Int32)+--   } deriving (Generic)+-- instance ProtoMessage Config+-- @+newtype ProtoMap k v = ProtoMap { unProtoMap :: Map k v }+  deriving (Show, Eq, Ord)

@@ -0,0 +1,305 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DefaultSignatures #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | GHC Generics integration for automatic protobuf encoding/decoding.+--+-- Define your message as a Haskell record with 'Field' wrappers,+-- derive 'Generic', and write an empty 'ProtoMessage' instance:+--+-- @+-- data User = User+--   { name  :: Field 1 Text+--   , age   :: Field 2 Int32+--   , email :: Field 3 (Maybe Text)+--   } deriving (Generic)+--+-- instance ProtoMessage User+-- @+--+-- Encoding and decoding are then available via 'encode' and 'decode'.+module Spire.Protobuf.Message+  ( ProtoMessage (..)+  , encode+  , decode+  , GProtoEncode (..)+  , GProtoDecode (..)+  ) where++import Data.ByteString (ByteString)+import qualified Data.Map.Strict as Map+import GHC.Generics+import GHC.TypeLits (KnownNat, natVal)+import Data.Proxy (Proxy(..))++import Spire.Protobuf.Wire+import Spire.Protobuf.Field+import Spire.Protobuf.Encode+import Spire.Protobuf.Decode+++-- ===================================================================+-- ProtoMessage class+-- ===================================================================++-- | Class for protobuf messages that can be encoded and decoded.+--+-- The default implementations use GHC Generics to walk the record+-- structure. Each field must be wrapped in 'Field' with a unique+-- field number.+class ProtoMessage a where+  protoEncode :: a -> ProtoBuilder+  default protoEncode :: (Generic a, GProtoEncode (Rep a)) => a -> ProtoBuilder+  protoEncode = gProtoEncode . from++  protoDecode :: ByteString -> Either DecodeError a+  default protoDecode :: (Generic a, GProtoDecode (Rep a)) => ByteString -> Either DecodeError a+  protoDecode bs = do+    rawFields <- parseFields bs+    to <$> gProtoDecode rawFields++-- | Encode a message to a strict 'ByteString'.+encode :: ProtoMessage a => a -> ByteString+encode = runProtoBuilder . protoEncode+{-# INLINE encode #-}++-- | Decode a message from a strict 'ByteString'.+decode :: ProtoMessage a => ByteString -> Either DecodeError a+decode = protoDecode+{-# INLINE decode #-}++-- ProtoMessage instance for submessage encoding+instance {-# OVERLAPPABLE #-} ProtoMessage a => ProtoEncode a where+  protoWireType = WireLengthDelimited+  protoEncodeValue a = encodeSubmessage (protoEncode a)+  {-# INLINE protoEncodeValue #-}++-- ProtoMessage instance for submessage decoding+instance {-# OVERLAPPABLE #-} ProtoMessage a => ProtoDecode a where+  protoDecodeValue (RawBytes bs) = protoDecode bs+  protoDecodeValue _             = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)+  {-# INLINE protoDecodeValue #-}+++-- ===================================================================+-- GProtoEncode: Generic encoding+-- ===================================================================++-- | Generic encoding class. Walks the 'Rep' of a type and encodes+-- each 'Field n a' it encounters.+class GProtoEncode f where+  gProtoEncode :: f p -> ProtoBuilder++-- M1: metadata wrappers (datatype, constructor, selector) — pass through+instance GProtoEncode f => GProtoEncode (M1 i c f) where+  gProtoEncode (M1 x) = gProtoEncode x+  {-# INLINE gProtoEncode #-}++-- :*: product — encode both sides+instance (GProtoEncode f, GProtoEncode g) => GProtoEncode (f :*: g) where+  gProtoEncode (f :*: g) = gProtoEncode f <> gProtoEncode g+  {-# INLINE gProtoEncode #-}++-- U1: unit (empty record)+instance GProtoEncode U1 where+  gProtoEncode U1 = mempty+  {-# INLINE gProtoEncode #-}++-- K1: a field of type Field n a — encode it+instance (KnownNat n, ProtoEncode a, Eq a, ProtoDefault a)+  => GProtoEncode (K1 i (Field n a)) where+  gProtoEncode (K1 fld) = encodeField fld+  {-# INLINE gProtoEncode #-}++-- K1: optional field — Field n (Maybe a)+instance {-# OVERLAPPING #-} (KnownNat n, ProtoEncode a)+  => GProtoEncode (K1 i (Field n (Maybe a))) where+  gProtoEncode (K1 fld) = encodeOptionalField fld+  {-# INLINE gProtoEncode #-}++-- K1: repeated field — Field n [a]+instance {-# OVERLAPPING #-} (KnownNat n, ProtoEncode a)+  => GProtoEncode (K1 i (Field n [a])) where+  gProtoEncode (K1 fld) = encodeRepeatedField fld+  {-# INLINE gProtoEncode #-}+++-- ===================================================================+-- GProtoDecode: Generic decoding+-- ===================================================================++-- | Generic decoding class. Constructs the 'Rep' of a type from a+-- list of raw (field_number, value) pairs.+--+-- The approach: parse all wire fields into @[(Int, RawField)]@ up front,+-- then for each record field, look up its field number in the list.+-- Unknown fields are silently ignored (proto3 forward-compatibility).+-- Last-wins semantics for duplicate field numbers.+class GProtoDecode f where+  gProtoDecode :: [(Int, RawField)] -> Either DecodeError (f p)++-- M1: metadata wrappers — pass through+instance GProtoDecode f => GProtoDecode (M1 i c f) where+  gProtoDecode rfs = M1 <$> gProtoDecode rfs+  {-# INLINE gProtoDecode #-}++-- :*: product — decode both sides from the same field list+instance (GProtoDecode f, GProtoDecode g) => GProtoDecode (f :*: g) where+  gProtoDecode rfs = do+    l <- gProtoDecode rfs+    r <- gProtoDecode rfs+    Right (l :*: r)+  {-# INLINE gProtoDecode #-}++-- U1: unit+instance GProtoDecode U1 where+  gProtoDecode _ = Right U1+  {-# INLINE gProtoDecode #-}++-- K1: required field — Field n a. Look up field number n; if absent, use default.+instance (KnownNat n, ProtoDecode a, ProtoDefault a)+  => GProtoDecode (K1 i (Field n a)) where+  gProtoDecode rfs =+    let fn = fromIntegral (natVal (Proxy @n))+    in case lookupLast fn rfs of+         Nothing  -> Right (K1 (Field protoDefault))+         Just raw -> K1 . Field <$> protoDecodeValue raw+  {-# INLINE gProtoDecode #-}++-- K1: optional field — Field n (Maybe a). Absent means Nothing.+instance {-# OVERLAPPING #-} (KnownNat n, ProtoDecode a)+  => GProtoDecode (K1 i (Field n (Maybe a))) where+  gProtoDecode rfs =+    let fn = fromIntegral (natVal (Proxy @n))+    in case lookupLast fn rfs of+         Nothing  -> Right (K1 (Field Nothing))+         Just raw -> K1 . Field . Just <$> protoDecodeValue raw+  {-# INLINE gProtoDecode #-}++-- K1: repeated field — Field n [a]. Collect all occurrences.+-- Handles both unpacked (each element tagged separately) and packed+-- (all elements in a single length-delimited blob) wire encodings.+-- For packable scalar types (Int32, Int64, Word32, Word64, Bool, Float,+-- Double, SInt32, SInt64), a RawBytes entry is automatically unpacked+-- into multiple values. For non-packable types (Text, ByteString,+-- submessages), each RawBytes is decoded as a single value.+instance {-# OVERLAPPING #-} (KnownNat n, DecodeRepeatedEntry a)+  => GProtoDecode (K1 i (Field n [a])) where+  gProtoDecode rfs =+    let fn = fromIntegral (natVal (Proxy @n))+        raws = [raw | (n', raw) <- rfs, n' == fn]+    in K1 . Field . concat <$> traverse decodeRepeatedEntry raws+  {-# INLINE gProtoDecode #-}+++-- ===================================================================+-- Helpers+-- ===================================================================++-- | Look up the last occurrence of a field number (last-wins proto3 semantics).+lookupLast :: Int -> [(Int, RawField)] -> Maybe RawField+lookupLast fn = go Nothing+  where+    go acc [] = acc+    go acc ((n, v) : rest)+      | n == fn   = go (Just v) rest+      | otherwise = go acc rest+{-# INLINE lookupLast #-}+++-- ===================================================================+-- ProtoMap: Proto3 map field support+-- ===================================================================++-- | Proto3 default for ProtoMap: empty map.+instance ProtoDefault (ProtoMap k v) where+  protoDefault = ProtoMap Map.empty++-- | Encode a ProtoMap as repeated length-delimited entries.+-- Each map entry is a submessage with field 1 = key, field 2 = value.+instance (Ord k, ProtoEncode k, ProtoEncode v) => ProtoEncode (ProtoMap k v) where+  protoWireType = WireLengthDelimited+  protoEncodeValue (ProtoMap m) =+    let encodeEntry k v =+          let keyEnc   = pbTag 1 (protoWireType @k) <> protoEncodeValue k+              valEnc   = pbTag 2 (protoWireType @v) <> protoEncodeValue v+              entryBody = keyEnc <> valEnc+          in encodeSubmessage entryBody+    in Map.foldlWithKey' (\acc k v -> acc <> encodeEntry k v) mempty m+  {-# INLINE protoEncodeValue #-}++-- | Decode a ProtoMap entry from a single RawBytes (one key-value pair submessage).+-- The caller (repeated field decoder) will collect all entries.+instance (Ord k, ProtoDecode k, ProtoDefault k, ProtoDecode v, ProtoDefault v)+  => ProtoDecode (ProtoMap k v) where+  protoDecodeValue (RawBytes bs) = do+    -- Parse the entry submessage+    rfs <- parseFields bs+    -- Extract key (field 1) and value (field 2), using defaults if absent+    k <- case lookupLast 1 rfs of+           Nothing  -> Right protoDefault+           Just raw -> protoDecodeValue raw+    v <- case lookupLast 2 rfs of+           Nothing  -> Right protoDefault+           Just raw -> protoDecodeValue raw+    Right (ProtoMap (Map.singleton k v))+  protoDecodeValue _ = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)+  {-# INLINE protoDecodeValue #-}++-- | DecodeRepeatedEntry for ProtoMap: each RawBytes is a single entry.+instance (Ord k, ProtoDecode k, ProtoDefault k, ProtoDecode v, ProtoDefault v)+  => DecodeRepeatedEntry (ProtoMap k v) where+  decodeRepeatedEntry raw = (: []) <$> protoDecodeValue raw+  {-# INLINE decodeRepeatedEntry #-}+++-- ===================================================================+-- ProtoMap Generics encoding/decoding+-- ===================================================================++-- K1: ProtoMap field — Field n (ProtoMap k v). Encode all entries as+-- repeated submessages with the same field number.+instance {-# OVERLAPPING #-}+  (KnownNat n, Ord k, ProtoEncode k, ProtoEncode v)+  => GProtoEncode (K1 i (Field n (ProtoMap k v))) where+  gProtoEncode (K1 (Field (ProtoMap m)))+    | Map.null m = mempty+    | otherwise =+      let fn = fromIntegral (natVal (Proxy @n)) :: Int+          tag = pbTag fn WireLengthDelimited+          encodeEntry k v =+            let keyEnc   = pbTag 1 (protoWireType @k) <> protoEncodeValue k+                valEnc   = pbTag 2 (protoWireType @v) <> protoEncodeValue v+                entryBody = keyEnc <> valEnc+            in tag <> encodeSubmessage entryBody+      in Map.foldlWithKey' (\acc k v -> acc <> encodeEntry k v) mempty m+  {-# INLINE gProtoEncode #-}++-- K1: ProtoMap field — Field n (ProtoMap k v). Decode by collecting all+-- repeated submessage entries for the field number and merging them.+instance {-# OVERLAPPING #-}+  (KnownNat n, Ord k, ProtoDecode k, ProtoDefault k, ProtoDecode v, ProtoDefault v)+  => GProtoDecode (K1 i (Field n (ProtoMap k v))) where+  gProtoDecode rfs =+    let fn = fromIntegral (natVal (Proxy @n))+        raws = [raw | (n', raw) <- rfs, n' == fn]+    in do+      entries <- traverse decodeMapEntry raws+      Right (K1 (Field (ProtoMap (Map.unions entries))))+  {-# INLINE gProtoDecode #-}++-- | Decode a single map entry submessage into a singleton Map.+decodeMapEntry :: (Ord k, ProtoDecode k, ProtoDefault k, ProtoDecode v, ProtoDefault v)+               => RawField -> Either DecodeError (Map.Map k v)+decodeMapEntry (RawBytes bs) = do+  rfs <- parseFields bs+  k <- case lookupLast 1 rfs of+         Nothing  -> Right protoDefault+         Just raw -> protoDecodeValue raw+  v <- case lookupLast 2 rfs of+         Nothing  -> Right protoDefault+         Just raw -> protoDecodeValue raw+  Right (Map.singleton k v)+decodeMapEntry _ = Left (UnexpectedWireType 0 WireLengthDelimited WireVarint)

@@ -0,0 +1,249 @@+-- | Protobuf wire format primitives.+--+-- The proto3 wire format uses 5 wire types. Each field on the wire is+-- a tag (field_number << 3 | wire_type) followed by the value.+--+-- This module provides low-level encoding and decoding of varints,+-- fixed-width values, and length-delimited fields.+module Spire.Protobuf.Wire+  ( -- * Wire types+    WireType (..)+    -- * Tags+  , encodeTag+  , decodeTag+    -- * Varint encoding/decoding+  , encodeVarint+  , decodeVarint+    -- * Zigzag encoding (for sint32/sint64)+  , zigzagEncode+  , zigzagDecode+    -- * Fixed-width encoding+  , encodeFixed32+  , encodeFixed64+  , decodeFixed32+  , decodeFixed64+    -- * Float/Double encoding+  , encodeProtoFloat+  , encodeProtoDouble+  , decodeProtoFloat+  , decodeProtoDouble+    -- * Length-delimited+  , encodeLengthDelimited+  , decodeLengthDelimited+    -- * Field skipping+  , skipField+  ) where++import Prelude hiding (encodeFloat, decodeFloat)+import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as B+import Data.Int (Int64)+import Data.Word (Word8, Word32, Word64)+import GHC.Float (castWord32ToFloat, castFloatToWord32,+                  castWord64ToDouble, castDoubleToWord64)+++-- | Proto3 wire types.+data WireType+  = WireVarint          -- ^ 0: int32, int64, uint32, uint64, sint32, sint64, bool, enum+  | WireFixed64         -- ^ 1: fixed64, sfixed64, double+  | WireLengthDelimited -- ^ 2: string, bytes, embedded messages, packed repeated+  | WireFixed32         -- ^ 5: fixed32, sfixed32, float+  deriving (Show, Eq)++wireTypeId :: WireType -> Word8+wireTypeId WireVarint          = 0+wireTypeId WireFixed64         = 1+wireTypeId WireLengthDelimited = 2+wireTypeId WireFixed32         = 5++wireTypeFromId :: Word8 -> Maybe WireType+wireTypeFromId 0 = Just WireVarint+wireTypeFromId 1 = Just WireFixed64+wireTypeFromId 2 = Just WireLengthDelimited+wireTypeFromId 5 = Just WireFixed32+wireTypeFromId _ = Nothing+++-- ===================================================================+-- Tags+-- ===================================================================++-- | Encode a field tag (field_number << 3 | wire_type).+encodeTag :: Int -> WireType -> B.Builder+encodeTag fieldNum wt =+  encodeVarint (fromIntegral fieldNum `shiftL` 3 .|. fromIntegral (wireTypeId wt))+{-# INLINE encodeTag #-}++-- | Decode a field tag. Returns (field_number, wire_type, remaining bytes).+decodeTag :: ByteString -> Maybe (Int, WireType, ByteString)+decodeTag bs = do+  (val, rest) <- decodeVarint bs+  let wireId = fromIntegral (val .&. 0x07) :: Word8+      fieldNum = fromIntegral (val `shiftR` 3)+  wt <- wireTypeFromId wireId+  Just (fieldNum, wt, rest)+{-# INLINE decodeTag #-}+++-- ===================================================================+-- Varint encoding/decoding+-- ===================================================================++-- | Encode a value as a varint (7 bits per byte, MSB continuation).+encodeVarint :: Word64 -> B.Builder+encodeVarint n+  | n < 0x80  = B.word8 (fromIntegral n)+  | otherwise = B.word8 (fromIntegral (n .&. 0x7F) .|. 0x80)+                <> encodeVarint (n `shiftR` 7)+{-# INLINE encodeVarint #-}++-- | Decode a varint. Returns (value, remaining bytes).+-- Rejects overlong encodings (more than 10 bytes or invalid high bits+-- in the 10th byte).+decodeVarint :: ByteString -> Maybe (Word64, ByteString)+decodeVarint = go 0 0+  where+    go !acc !shft !bs = case BS.uncons bs of+      Nothing -> Nothing+      Just (b, rest) ->+        let val = acc .|. (fromIntegral (b .&. 0x7F) `shiftL` shft)+        in if b .&. 0x80 == 0+           then if shft == 63 && (b .&. 0x7E) /= 0+                then Nothing  -- reject overlong encoding at byte 10+                else Just (val, rest)+           else if shft >= 63+                then Nothing  -- overflow protection+                else go val (shft + 7) rest+{-# INLINE decodeVarint #-}+++-- ===================================================================+-- Zigzag encoding (for sint32/sint64)+-- ===================================================================++-- | Zigzag-encode a signed integer: maps negatives to odds, positives to evens.+-- This makes small negative numbers small on the wire.+zigzagEncode :: Int64 -> Word64+zigzagEncode n = fromIntegral ((n `shiftL` 1) `xor` (n `shiftR` 63))+{-# INLINE zigzagEncode #-}++-- | Zigzag-decode.+zigzagDecode :: Word64 -> Int64+zigzagDecode n = fromIntegral ((n `shiftR` 1) `xor` negate (n .&. 1))+{-# INLINE zigzagDecode #-}+++-- ===================================================================+-- Fixed-width encoding+-- ===================================================================++-- | Encode a 32-bit value in little-endian.+encodeFixed32 :: Word32 -> B.Builder+encodeFixed32 = B.word32LE+{-# INLINE encodeFixed32 #-}++-- | Encode a 64-bit value in little-endian.+encodeFixed64 :: Word64 -> B.Builder+encodeFixed64 = B.word64LE+{-# INLINE encodeFixed64 #-}++-- | Decode a 32-bit little-endian value.+decodeFixed32 :: ByteString -> Maybe (Word32, ByteString)+decodeFixed32 bs+  | BS.length bs < 4 = Nothing+  | otherwise =+    let b0 = fromIntegral (BS.index bs 0) :: Word32+        b1 = fromIntegral (BS.index bs 1) :: Word32+        b2 = fromIntegral (BS.index bs 2) :: Word32+        b3 = fromIntegral (BS.index bs 3) :: Word32+    in Just (b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24),+             BS.drop 4 bs)+{-# INLINE decodeFixed32 #-}++-- | Decode a 64-bit little-endian value.+decodeFixed64 :: ByteString -> Maybe (Word64, ByteString)+decodeFixed64 bs+  | BS.length bs < 8 = Nothing+  | otherwise =+    let readByte i = fromIntegral (BS.index bs i) :: Word64+    in Just ( readByte 0 .|. (readByte 1 `shiftL` 8) .|. (readByte 2 `shiftL` 16)+              .|. (readByte 3 `shiftL` 24) .|. (readByte 4 `shiftL` 32)+              .|. (readByte 5 `shiftL` 40) .|. (readByte 6 `shiftL` 48)+              .|. (readByte 7 `shiftL` 56),+              BS.drop 8 bs)+{-# INLINE decodeFixed64 #-}+++-- ===================================================================+-- Float/Double+-- ===================================================================++-- | Encode a Float (as fixed32, little-endian IEEE 754).+encodeProtoFloat :: Float -> B.Builder+encodeProtoFloat = encodeFixed32 . castFloatToWord32+{-# INLINE encodeProtoFloat #-}++-- | Encode a Double (as fixed64, little-endian IEEE 754).+encodeProtoDouble :: Double -> B.Builder+encodeProtoDouble = encodeFixed64 . castDoubleToWord64+{-# INLINE encodeProtoDouble #-}++-- | Decode a Float.+decodeProtoFloat :: ByteString -> Maybe (Float, ByteString)+decodeProtoFloat bs = do+  (w, rest) <- decodeFixed32 bs+  Just (castWord32ToFloat w, rest)+{-# INLINE decodeProtoFloat #-}++-- | Decode a Double.+decodeProtoDouble :: ByteString -> Maybe (Double, ByteString)+decodeProtoDouble bs = do+  (w, rest) <- decodeFixed64 bs+  Just (castWord64ToDouble w, rest)+{-# INLINE decodeProtoDouble #-}+++-- ===================================================================+-- Length-delimited+-- ===================================================================++-- | Encode a length-delimited value: varint length + bytes.+encodeLengthDelimited :: ByteString -> B.Builder+encodeLengthDelimited bs =+  encodeVarint (fromIntegral (BS.length bs)) <> B.byteString bs+{-# INLINE encodeLengthDelimited #-}++-- | Decode a length-delimited value. Returns (bytes, remaining).+-- Zero-copy: returns a slice of the input ByteString.+decodeLengthDelimited :: ByteString -> Maybe (ByteString, ByteString)+decodeLengthDelimited bs = do+  (len, rest) <- decodeVarint bs+  let n = fromIntegral len+  if BS.length rest < n+    then Nothing+    else Just (BS.take n rest, BS.drop n rest)+{-# INLINE decodeLengthDelimited #-}+++-- ===================================================================+-- Field skipping (for unknown fields)+-- ===================================================================++-- | Skip a field value based on its wire type. Returns remaining bytes.+skipField :: WireType -> ByteString -> Maybe ByteString+skipField WireVarint bs = do+  (_, rest) <- decodeVarint bs+  Just rest+skipField WireFixed64 bs+  | BS.length bs >= 8 = Just (BS.drop 8 bs)+  | otherwise = Nothing+skipField WireLengthDelimited bs = do+  (_, rest) <- decodeLengthDelimited bs+  Just rest+skipField WireFixed32 bs+  | BS.length bs >= 4 = Just (BS.drop 4 bs)+  | otherwise = Nothing+{-# INLINE skipField #-}

@@ -0,0 +1,1511 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Main (main) where++import Control.Exception (try, SomeException)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Either (isRight)+import Data.Int (Int32, Int64)+import Data.List (isInfixOf)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import System.IO (hSetBinaryMode, hFlush, hClose, hGetContents)+import System.Process (proc, createProcess, waitForProcess,+                       readProcess, StdStream(..), std_in, std_out, std_err)++import Spire.Protobuf+import Spire.Protobuf.Wire+import Spire.Protobuf.Encode+import Spire.Protobuf.Decode+++-- ===================================================================+-- Test helpers+-- ===================================================================++assert :: String -> Bool -> IO ()+assert label True  = putStrLn $ "  OK: " ++ label+assert label False = error   $ "FAIL: " ++ label++-- | Helper: build a ByteString from a Builder-producing function+buildBS :: ProtoBuilder -> ByteString+buildBS = runProtoBuilder+++-- ===================================================================+-- Test message types+-- ===================================================================++data Simple = Simple+  { sName :: Field 1 Text+  , sAge  :: Field 2 Int32+  } deriving (Show, Eq, Generic)++instance ProtoMessage Simple++data WithOpt = WithOpt+  { wName :: Field 1 Text+  , wNick :: Field 2 (Maybe Text)+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithOpt++data WithList = WithList+  { wTags :: Field 1 [Text]+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithList++data AllDefaults = AllDefaults+  { dName :: Field 1 Text+  , dAge  :: Field 2 Int32+  , dFlag :: Field 3 Bool+  } deriving (Show, Eq, Generic)++instance ProtoMessage AllDefaults++data Address = Address+  { city :: Field 1 Text+  , addrZip :: Field 2 Int32+  } deriving (Show, Eq, Generic)++instance ProtoMessage Address++data Person = Person+  { pName :: Field 1 Text+  , pAddr :: Field 2 (Maybe Address)+  } deriving (Show, Eq, Generic)++instance ProtoMessage Person++data WithRepeatedInt = WithRepeatedInt+  { riName :: Field 1 Text+  , riNums :: Field 2 [Int32]+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithRepeatedInt+++-- ===================================================================+-- 1. Wire primitives: Varint+-- ===================================================================++testVarintRoundtrip :: IO ()+testVarintRoundtrip = do+  putStrLn "=== Varint roundtrip ==="+  let check val = do+        let bs = buildBS (ProtoBuilder (varintSz val) (encodeVarint val))+        case decodeVarint bs of+          Just (v, rest) -> do+            assert ("varint roundtrip " ++ show val) (v == val)+            assert ("varint no leftover " ++ show val) (BS.null rest)+          Nothing -> error $ "FAIL: varint decode failed for " ++ show val+  check 0+  check 1+  check 127+  check 128+  check 300+  check (fromIntegral (maxBound @Word32) :: Word64)+  check (maxBound @Word64)+  where+    varintSz :: Word64 -> Int+    varintSz n+      | n < 0x80       = 1+      | n < 0x4000     = 2+      | n < 0x200000   = 3+      | n < 0x10000000 = 4+      | n < 0x0800000000 = 5+      | n < 0x040000000000 = 6+      | n < 0x02000000000000 = 7+      | n < 0x0100000000000000 = 8+      | n < 0x8000000000000000 = 9+      | otherwise = 10++-- ===================================================================+-- 2. Wire primitives: Zigzag+-- ===================================================================++testZigzagRoundtrip :: IO ()+testZigzagRoundtrip = do+  putStrLn "=== Zigzag roundtrip ==="+  let check val = assert ("zigzag roundtrip " ++ show val)+                         (zigzagDecode (zigzagEncode val) == val)+  check 0+  check (-1)+  check 1+  check (-2)+  check 2+  check (minBound @Int64)+  check (maxBound @Int64)+++-- ===================================================================+-- 3. Wire primitives: Fixed32/Fixed64+-- ===================================================================++testFixed32Roundtrip :: IO ()+testFixed32Roundtrip = do+  putStrLn "=== Fixed32 roundtrip ==="+  let check val = do+        let bs = buildBS (ProtoBuilder 4 (encodeFixed32 val))+        case decodeFixed32 bs of+          Just (v, rest) -> do+            assert ("fixed32 roundtrip " ++ show val) (v == val)+            assert ("fixed32 no leftover " ++ show val) (BS.null rest)+          Nothing -> error $ "FAIL: fixed32 decode failed for " ++ show val+  check 0+  check 1+  check 255+  check 65535+  check (maxBound @Word32)++testFixed64Roundtrip :: IO ()+testFixed64Roundtrip = do+  putStrLn "=== Fixed64 roundtrip ==="+  let check val = do+        let bs = buildBS (ProtoBuilder 8 (encodeFixed64 val))+        case decodeFixed64 bs of+          Just (v, rest) -> do+            assert ("fixed64 roundtrip " ++ show val) (v == val)+            assert ("fixed64 no leftover " ++ show val) (BS.null rest)+          Nothing -> error $ "FAIL: fixed64 decode failed for " ++ show val+  check 0+  check 1+  check (maxBound @Word64)+  check 0xDEADBEEFCAFEBABE+++-- ===================================================================+-- 4. Wire primitives: Float/Double+-- ===================================================================++testFloatRoundtrip :: IO ()+testFloatRoundtrip = do+  putStrLn "=== Float roundtrip ==="+  let check val = do+        let bs = buildBS (ProtoBuilder 4 (encodeProtoFloat val))+        case decodeProtoFloat bs of+          Just (v, rest) -> do+            assert ("float roundtrip " ++ show val) (v == val)+            assert ("float no leftover " ++ show val) (BS.null rest)+          Nothing -> error $ "FAIL: float decode failed for " ++ show val+  check 0.0+  check 1.5+  check (-3.14)+  check (1.0 / 0.0)  -- infinity++  -- NaN: NaN /= NaN, so test with isNaN+  let nanBs = buildBS (ProtoBuilder 4 (encodeProtoFloat (0.0 / 0.0)))+  case decodeProtoFloat nanBs of+    Just (v, rest) -> do+      assert "float NaN roundtrip" (isNaN v)+      assert "float NaN no leftover" (BS.null rest)+    Nothing -> error "FAIL: float NaN decode failed"++testDoubleRoundtrip :: IO ()+testDoubleRoundtrip = do+  putStrLn "=== Double roundtrip ==="+  let check val = do+        let bs = buildBS (ProtoBuilder 8 (encodeProtoDouble val))+        case decodeProtoDouble bs of+          Just (v, rest) -> do+            assert ("double roundtrip " ++ show val) (v == val)+            assert ("double no leftover " ++ show val) (BS.null rest)+          Nothing -> error $ "FAIL: double decode failed for " ++ show val+  check 0.0+  check 1.5+  check (-3.14)+  check (1.0 / 0.0)++  let nanBs = buildBS (ProtoBuilder 8 (encodeProtoDouble (0.0 / 0.0)))+  case decodeProtoDouble nanBs of+    Just (v, rest) -> do+      assert "double NaN roundtrip" (isNaN v)+      assert "double NaN no leftover" (BS.null rest)+    Nothing -> error "FAIL: double NaN decode failed"+++-- ===================================================================+-- 5. Wire primitives: Tags+-- ===================================================================++testTagEncodeDecode :: IO ()+testTagEncodeDecode = do+  putStrLn "=== Tag encode/decode ==="++  -- field 1, varint+  let bs1 = buildBS (ProtoBuilder 1 (encodeTag 1 WireVarint))+  case decodeTag bs1 of+    Just (fn, wt, rest) -> do+      assert "tag field 1 varint: field number" (fn == 1)+      assert "tag field 1 varint: wire type" (wt == WireVarint)+      assert "tag field 1 varint: no leftover" (BS.null rest)+    Nothing -> error "FAIL: tag decode failed"++  -- field 15, length-delimited+  let bs2 = buildBS (ProtoBuilder 1 (encodeTag 15 WireLengthDelimited))+  case decodeTag bs2 of+    Just (fn, wt, rest) -> do+      assert "tag field 15 ld: field number" (fn == 15)+      assert "tag field 15 ld: wire type" (wt == WireLengthDelimited)+      assert "tag field 15 ld: no leftover" (BS.null rest)+    Nothing -> error "FAIL: tag decode failed"++  -- field 536870911 (max field number: 2^29 - 1)+  let bs3 = buildBS (ProtoBuilder 5 (encodeTag 536870911 WireVarint))+  case decodeTag bs3 of+    Just (fn, wt, _) -> do+      assert "tag max field: field number" (fn == 536870911)+      assert "tag max field: wire type" (wt == WireVarint)+    Nothing -> error "FAIL: tag decode failed for max field"+++-- ===================================================================+-- 6. Wire primitives: Length-delimited+-- ===================================================================++testLengthDelimitedRoundtrip :: IO ()+testLengthDelimitedRoundtrip = do+  putStrLn "=== Length-delimited roundtrip ==="++  -- empty+  let emptyBs = buildBS (ProtoBuilder 1 (encodeLengthDelimited BS.empty))+  case decodeLengthDelimited emptyBs of+    Just (val, rest) -> do+      assert "length-delimited empty: value" (val == BS.empty)+      assert "length-delimited empty: no leftover" (BS.null rest)+    Nothing -> error "FAIL: length-delimited empty decode failed"++  -- "hello"+  let hello = "hello" :: ByteString+      helloBs = buildBS (ProtoBuilder (1 + BS.length hello) (encodeLengthDelimited hello))+  case decodeLengthDelimited helloBs of+    Just (val, rest) -> do+      assert "length-delimited hello: value" (val == hello)+      assert "length-delimited hello: no leftover" (BS.null rest)+    Nothing -> error "FAIL: length-delimited hello decode failed"++  -- 1000 bytes+  let bigBs = BS.replicate 1000 0x42+      bigEncoded = buildBS (ProtoBuilder (2 + 1000) (encodeLengthDelimited bigBs))+  case decodeLengthDelimited bigEncoded of+    Just (val, rest) -> do+      assert "length-delimited 1000 bytes: value" (val == bigBs)+      assert "length-delimited 1000 bytes: no leftover" (BS.null rest)+    Nothing -> error "FAIL: length-delimited 1000 bytes decode failed"+++-- ===================================================================+-- 7. Wire primitives: Skip field+-- ===================================================================++testSkipField :: IO ()+testSkipField = do+  putStrLn "=== Skip field ==="++  -- skip varint+  let varintBs = buildBS (ProtoBuilder 1 (encodeVarint 42)) <> "tail"+  case skipField WireVarint varintBs of+    Just rest -> assert "skip varint" (rest == "tail")+    Nothing -> error "FAIL: skip varint failed"++  -- skip fixed32+  let f32Bs = buildBS (ProtoBuilder 4 (encodeFixed32 0)) <> "tail"+  case skipField WireFixed32 f32Bs of+    Just rest -> assert "skip fixed32" (rest == "tail")+    Nothing -> error "FAIL: skip fixed32 failed"++  -- skip fixed64+  let f64Bs = buildBS (ProtoBuilder 8 (encodeFixed64 0)) <> "tail"+  case skipField WireFixed64 f64Bs of+    Just rest -> assert "skip fixed64" (rest == "tail")+    Nothing -> error "FAIL: skip fixed64 failed"++  -- skip length-delimited+  let ldBs = buildBS (ProtoBuilder 6 (encodeLengthDelimited "hello")) <> "tail"+  case skipField WireLengthDelimited ldBs of+    Just rest -> assert "skip length-delimited" (rest == "tail")+    Nothing -> error "FAIL: skip length-delimited failed"+++-- ===================================================================+-- 8. Encoding: ProtoEncode Int32+-- ===================================================================++testEncodeInt32 :: IO ()+testEncodeInt32 = do+  putStrLn "=== ProtoEncode Int32 ==="++  -- Non-default encodes as varint+  let pb = protoEncodeValue @Int32 42+  assert "Int32 42: encodes non-empty" (pbLength pb > 0)++  -- Field encoding: tag + value+  let fpb = encodeField (Field 42 :: Field 1 Int32)+  assert "Int32 field 1 42: encodes non-empty" (pbLength fpb > 0)++  -- Default (0) is skipped+  let defPb = encodeField (Field 0 :: Field 1 Int32)+  assert "Int32 default (0) is skipped" (pbLength defPb == 0)+++-- ===================================================================+-- 9. Encoding: ProtoEncode Bool+-- ===================================================================++testEncodeBool :: IO ()+testEncodeBool = do+  putStrLn "=== ProtoEncode Bool ==="++  -- True -> varint 1+  let truePb = protoEncodeValue True+  let trueBytes = runProtoBuilder truePb+  case decodeVarint trueBytes of+    Just (v, _) -> assert "Bool True encodes to varint 1" (v == 1)+    Nothing -> error "FAIL: Bool True encode failed"++  -- False -> field is skipped (default)+  let defPb = encodeField (Field False :: Field 1 Bool)+  assert "Bool False (default) is skipped" (pbLength defPb == 0)+++-- ===================================================================+-- 10. Encoding: ProtoEncode Text+-- ===================================================================++testEncodeText :: IO ()+testEncodeText = do+  putStrLn "=== ProtoEncode Text ==="++  let pb = protoEncodeValue ("hello" :: Text)+  -- length-delimited: varint(5) + "hello" = 6 bytes+  assert "Text 'hello': length 6" (pbLength pb == 6)++  -- Field encoding+  let fpb = encodeField (Field "hello" :: Field 1 Text)+  assert "Text field non-empty" (pbLength fpb > 0)++  -- Default ("") is skipped+  let defPb = encodeField (Field "" :: Field 1 Text)+  assert "Text default ('') is skipped" (pbLength defPb == 0)+++-- ===================================================================+-- 11. Encoding: ProtoEncode ByteString+-- ===================================================================++testEncodeByteString :: IO ()+testEncodeByteString = do+  putStrLn "=== ProtoEncode ByteString ==="++  let bs = "world" :: ByteString+      pb = protoEncodeValue bs+  -- varint(5) + "world" = 6 bytes+  assert "ByteString 'world': length 6" (pbLength pb == 6)++  -- Default (empty) is skipped+  let defPb = encodeField (Field BS.empty :: Field 1 ByteString)+  assert "ByteString default (empty) is skipped" (pbLength defPb == 0)+++-- ===================================================================+-- 12. Encoding: Optional and Repeated fields+-- ===================================================================++testEncodeOptionalField :: IO ()+testEncodeOptionalField = do+  putStrLn "=== Optional field encoding ==="++  -- Nothing -> empty+  let nothingPb = encodeOptionalField (Field Nothing :: Field 1 (Maybe Text))+  assert "Nothing encodes to empty" (pbLength nothingPb == 0)++  -- Just val -> field+  let justPb = encodeOptionalField (Field (Just "hi") :: Field 1 (Maybe Text))+  assert "Just 'hi' encodes non-empty" (pbLength justPb > 0)++testEncodeRepeatedField :: IO ()+testEncodeRepeatedField = do+  putStrLn "=== Repeated field encoding ==="++  -- Empty list -> empty+  let emptyPb = encodeRepeatedField (Field [] :: Field 1 [Text])+  assert "empty list encodes to empty" (pbLength emptyPb == 0)++  -- Non-empty list+  let listPb = encodeRepeatedField (Field ["a", "b", "c"] :: Field 1 [Text])+  assert "list [a,b,c] encodes non-empty" (pbLength listPb > 0)+++-- ===================================================================+-- 13. Encoding: ProtoBuilder length tracking+-- ===================================================================++testProtoBuilderLength :: IO ()+testProtoBuilderLength = do+  putStrLn "=== ProtoBuilder length tracking ==="++  -- Build several values and verify pbLength matches actual encoded bytes+  let pb1 = protoEncodeValue @Int32 42+      bs1 = runProtoBuilder pb1+  assert "Int32 42: pbLength matches actual" (pbLength pb1 == BS.length bs1)++  let pb2 = protoEncodeValue ("hello world" :: Text)+      bs2 = runProtoBuilder pb2+  assert "Text: pbLength matches actual" (pbLength pb2 == BS.length bs2)++  let pb3 = protoEncodeValue @Double 3.14+      bs3 = runProtoBuilder pb3+  assert "Double: pbLength matches actual" (pbLength pb3 == BS.length bs3)++  -- Combined+  let combined = pb1 <> pb2 <> pb3+      bsAll = runProtoBuilder combined+  assert "combined: pbLength matches actual" (pbLength combined == BS.length bsAll)+++-- ===================================================================+-- 14. Decoding: ProtoDecode Int32+-- ===================================================================++testDecodeInt32 :: IO ()+testDecodeInt32 = do+  putStrLn "=== ProtoDecode Int32 ==="++  assert "Int32 from varint 42" (protoDecodeValue @Int32 (RawVarint 42) == Right 42)+  assert "Int32 from varint 0"  (protoDecodeValue @Int32 (RawVarint 0) == Right 0)++  -- Wrong wire type+  case protoDecodeValue @Int32 (RawBytes "hello") of+    Left _ -> assert "Int32 rejects RawBytes" True+    Right _ -> assert "Int32 rejects RawBytes" False+++-- ===================================================================+-- 15. Decoding: ProtoDecode Text+-- ===================================================================++testDecodeText :: IO ()+testDecodeText = do+  putStrLn "=== ProtoDecode Text ==="++  assert "Text from RawBytes 'hello'" (protoDecodeValue @Text (RawBytes "hello") == Right "hello")+  assert "Text from RawBytes empty"   (protoDecodeValue @Text (RawBytes "") == Right "")++  -- Invalid UTF-8+  let badUtf8 = BS.pack [0xFF, 0xFE]+  case protoDecodeValue @Text (RawBytes badUtf8) of+    Left InvalidUtf8 -> assert "Text rejects invalid UTF-8" True+    _                -> assert "Text rejects invalid UTF-8" False+++-- ===================================================================+-- 16. Decoding: ProtoDecode ByteString+-- ===================================================================++testDecodeByteString :: IO ()+testDecodeByteString = do+  putStrLn "=== ProtoDecode ByteString ==="++  assert "ByteString from RawBytes" (protoDecodeValue @ByteString (RawBytes "hello") == Right "hello")+  assert "ByteString from RawBytes empty" (protoDecodeValue @ByteString (RawBytes "") == Right "")+++-- ===================================================================+-- 17. Decoding: parseFields+-- ===================================================================++testParseFields :: IO ()+testParseFields = do+  putStrLn "=== parseFields ==="++  -- Encode a Simple message and parse the raw fields+  let msg = Simple (Field "Alice") (Field 30)+      bs = encode msg+  case parseFields bs of+    Right fields -> do+      assert "parseFields: 2 fields" (length fields == 2)+      -- field 1 should be RawBytes (text)+      case lookup 1 fields of+        Just (RawBytes v) -> assert "parseFields: field 1 is 'Alice'" (v == "Alice")+        _ -> assert "parseFields: field 1 is RawBytes" False+      -- field 2 should be RawVarint+      case lookup 2 fields of+        Just (RawVarint v) -> assert "parseFields: field 2 is 30" (v == 30)+        _ -> assert "parseFields: field 2 is RawVarint" False+    Left err -> error $ "FAIL: parseFields failed: " ++ show err++  -- Empty input+  case parseFields BS.empty of+    Right fields -> assert "parseFields: empty input -> empty list" (null fields)+    Left err -> error $ "FAIL: parseFields empty failed: " ++ show err+++-- ===================================================================+-- 18. Decoding: Unknown fields skipped+-- ===================================================================++testUnknownFields :: IO ()+testUnknownFields = do+  putStrLn "=== Unknown fields skipped ==="++  -- Encode a Simple message, then try to decode it as AllDefaults+  -- (which expects fields 1, 2, 3). Since Simple only has fields 1, 2,+  -- field 3 will use its default.+  let msg = Simple (Field "Bob") (Field 25)+      bs = encode msg+  case decode @AllDefaults bs of+    Right ad -> do+      assert "unknown fields: name preserved" (unField (dName ad) == "Bob")+      assert "unknown fields: age preserved" (unField (dAge ad) == 25)+      assert "unknown fields: flag defaults to False" (unField (dFlag ad) == False)+    Left err -> error $ "FAIL: unknown fields decode failed: " ++ show err+++-- ===================================================================+-- 19. ProtoMessage: Simple roundtrip+-- ===================================================================++testSimpleRoundtrip :: IO ()+testSimpleRoundtrip = do+  putStrLn "=== Simple message roundtrip ==="++  let msg = Simple (Field "Alice") (Field 30)+      bs = encode msg+  case decode bs of+    Right msg' -> assert "Simple roundtrip" (msg == msg')+    Left err -> error $ "FAIL: Simple roundtrip: " ++ show err+++-- ===================================================================+-- 20. ProtoMessage: Optional fields+-- ===================================================================++testOptionalRoundtrip :: IO ()+testOptionalRoundtrip = do+  putStrLn "=== Optional fields roundtrip ==="++  -- With value+  let msg1 = WithOpt (Field "Alice") (Field (Just "Ali"))+  case decode (encode msg1) of+    Right msg1' -> assert "WithOpt Just roundtrip" (msg1 == msg1')+    Left err -> error $ "FAIL: WithOpt Just roundtrip: " ++ show err++  -- Without value+  let msg2 = WithOpt (Field "Bob") (Field Nothing)+  case decode (encode msg2) of+    Right msg2' -> assert "WithOpt Nothing roundtrip" (msg2 == msg2')+    Left err -> error $ "FAIL: WithOpt Nothing roundtrip: " ++ show err+++-- ===================================================================+-- 21. ProtoMessage: Repeated fields+-- ===================================================================++testRepeatedRoundtrip :: IO ()+testRepeatedRoundtrip = do+  putStrLn "=== Repeated fields roundtrip ==="++  let msg = WithList (Field ["alpha", "beta", "gamma"])+  case decode (encode msg) of+    Right msg' -> assert "WithList roundtrip" (msg == msg')+    Left err -> error $ "FAIL: WithList roundtrip: " ++ show err++  -- Empty list+  let msgEmpty = WithList (Field [])+  case decode (encode msgEmpty) of+    Right msg' -> assert "WithList empty roundtrip" (msg' == msgEmpty)+    Left err -> error $ "FAIL: WithList empty roundtrip: " ++ show err+++-- ===================================================================+-- 22. ProtoMessage: All-default values+-- ===================================================================++testDefaultsEncoding :: IO ()+testDefaultsEncoding = do+  putStrLn "=== Default values encoding ==="++  let msg = AllDefaults (Field "") (Field 0) (Field False)+      bs = encode msg+  assert "all-default message encodes to empty bytes" (BS.null bs)+++-- ===================================================================+-- 23. ProtoMessage: Missing fields use defaults+-- ===================================================================++testMissingFieldsDefault :: IO ()+testMissingFieldsDefault = do+  putStrLn "=== Missing fields use defaults ==="++  -- Decode empty bytes as AllDefaults+  case decode @AllDefaults BS.empty of+    Right ad -> do+      assert "missing field: name defaults to ''" (unField (dName ad) == "")+      assert "missing field: age defaults to 0" (unField (dAge ad) == 0)+      assert "missing field: flag defaults to False" (unField (dFlag ad) == False)+    Left err -> error $ "FAIL: missing fields decode: " ++ show err+++-- ===================================================================+-- 24. Nested message roundtrip+-- ===================================================================++testNestedMessageRoundtrip :: IO ()+testNestedMessageRoundtrip = do+  putStrLn "=== Nested message roundtrip ==="++  let addr = Address (Field "Springfield") (Field 62704)+      person = Person (Field "Homer") (Field (Just addr))+      bs = encode person+  case decode bs of+    Right person' -> assert "nested message roundtrip" (person == person')+    Left err -> error $ "FAIL: nested message roundtrip: " ++ show err++  -- Nested with Nothing+  let person2 = Person (Field "Bart") (Field Nothing)+  case decode (encode person2) of+    Right person2' -> assert "nested message Nothing roundtrip" (person2 == person2')+    Left err -> error $ "FAIL: nested Nothing roundtrip: " ++ show err+++-- ===================================================================+-- 25. Out-of-order field decoding+-- ===================================================================++testOutOfOrderDecoding :: IO ()+testOutOfOrderDecoding = do+  putStrLn "=== Out-of-order field decoding ==="++  -- Manually build bytes with field 2 (Int32, varint) before field 1 (Text, length-delimited)+  -- Field 2: tag = (2 << 3 | 0) = 16 = 0x10, value = varint 25+  -- Field 1: tag = (1 << 3 | 2) = 10 = 0x0A, value = length-delimited "Alice"+  let field2Bytes = buildBS (ProtoBuilder 1 (encodeTag 2 WireVarint))+                 <> buildBS (ProtoBuilder 1 (encodeVarint 25))+      field1Bytes = buildBS (ProtoBuilder 1 (encodeTag 1 WireLengthDelimited))+                 <> buildBS (ProtoBuilder 6 (encodeLengthDelimited "Alice"))+      outOfOrder = field2Bytes <> field1Bytes+  case decode @Simple outOfOrder of+    Right msg -> do+      assert "out-of-order: name is Alice" (unField (sName msg) == "Alice")+      assert "out-of-order: age is 25" (unField (sAge msg) == 25)+    Left err -> error $ "FAIL: out-of-order decode: " ++ show err+++-- ===================================================================+-- 26. Duplicate field (last-wins)+-- ===================================================================++testDuplicateFieldLastWins :: IO ()+testDuplicateFieldLastWins = do+  putStrLn "=== Duplicate field (last-wins) ==="++  -- Encode field 1 as "first", then field 2 as 10, then field 1 again as "second"+  let f1first = buildBS (ProtoBuilder 1 (encodeTag 1 WireLengthDelimited))+             <> buildBS (ProtoBuilder 6 (encodeLengthDelimited "first"))+      f2val   = buildBS (ProtoBuilder 1 (encodeTag 2 WireVarint))+             <> buildBS (ProtoBuilder 1 (encodeVarint 10))+      f1second = buildBS (ProtoBuilder 1 (encodeTag 1 WireLengthDelimited))+              <> buildBS (ProtoBuilder 7 (encodeLengthDelimited "second"))+      combined = f1first <> f2val <> f1second+  case decode @Simple combined of+    Right msg -> do+      assert "duplicate field last-wins: name is 'second'" (unField (sName msg) == "second")+      assert "duplicate field last-wins: age is 10" (unField (sAge msg) == 10)+    Left err -> error $ "FAIL: duplicate field decode: " ++ show err+++-- ===================================================================+-- 27. Malformed input tests+-- ===================================================================++testMalformedInput :: IO ()+testMalformedInput = do+  putStrLn "=== Malformed input tests ==="++  -- Truncated varint: 0x80 has continuation bit set but no following byte+  let truncVarint = BS.pack [0x80]+  case decode @Simple truncVarint of+    Left _ -> assert "truncated varint returns Left" True+    Right _ -> assert "truncated varint returns Left" False++  -- Truncated length-delimited: tag for field 1 string + varint length 100 + only 5 bytes+  let tagBytes = buildBS (ProtoBuilder 1 (encodeTag 1 WireLengthDelimited))+      lenBytes = buildBS (ProtoBuilder 1 (encodeVarint 100))+      dataBytes = BS.replicate 5 0x41+      truncLD = tagBytes <> lenBytes <> dataBytes+  case decode @Simple truncLD of+    Left _ -> assert "truncated length-delimited returns Left" True+    Right _ -> assert "truncated length-delimited returns Left" False++  -- Empty input: decode as Simple -> returns message with all defaults+  case decode @Simple BS.empty of+    Right msg -> do+      assert "empty input: name defaults to ''" (unField (sName msg) == "")+      assert "empty input: age defaults to 0" (unField (sAge msg) == 0)+    Left err -> error $ "FAIL: empty input decode: " ++ show err++  -- Single byte 0xFF -> decode returns Left (invalid tag: wire type 7 is unknown)+  let badByte = BS.pack [0xFF]+  case decode @Simple badByte of+    Left _ -> assert "single byte 0xFF returns Left" True+    Right _ -> assert "single byte 0xFF returns Left" False+++-- ===================================================================+-- 28. Overlong varint rejection+-- ===================================================================++testOverlongVarintRejection :: IO ()+testOverlongVarintRejection = do+  putStrLn "=== Overlong varint rejection ==="++  -- Construct a 10-byte varint where byte 10 has bits 1-6 set.+  -- 9 continuation bytes (0x80) + final byte with high bits: 0x7E (bits 1-6 set)+  -- This represents a varint that overflows the 64-bit space.+  let overlongVarint = BS.pack [0x80, 0x80, 0x80, 0x80, 0x80,+                                0x80, 0x80, 0x80, 0x80, 0x7E]+  case decodeVarint overlongVarint of+    Nothing -> assert "overlong varint rejected" True+    Just _  -> assert "overlong varint rejected" False++  -- A valid 10-byte varint (max Word64) should still decode+  -- maxBound :: Word64 = 0xFFFFFFFFFFFFFFFF+  -- As varint: 9 bytes of 0xFF + final byte 0x01+  let maxVarint = BS.pack [0xFF, 0xFF, 0xFF, 0xFF, 0xFF,+                           0xFF, 0xFF, 0xFF, 0xFF, 0x01]+  case decodeVarint maxVarint of+    Just (v, rest) -> do+      assert "max varint decodes correctly" (v == maxBound @Word64)+      assert "max varint no leftover" (BS.null rest)+    Nothing -> assert "max varint decodes correctly" False+++-- ===================================================================+-- 29. Zigzag encoding of negative values+-- ===================================================================++testZigzagNegativeEfficiency :: IO ()+testZigzagNegativeEfficiency = do+  putStrLn "=== Zigzag negative value efficiency ==="++  -- Small negatives should produce small zigzag-encoded values+  assert "zigzag(-1) = 1" (zigzagEncode (-1) == 1)+  assert "zigzag(-2) = 3" (zigzagEncode (-2) == 3)+  assert "zigzag(-100) = 199" (zigzagEncode (-100) == 199)++  -- Positive values should also be small+  assert "zigzag(0) = 0" (zigzagEncode 0 == 0)+  assert "zigzag(1) = 2" (zigzagEncode 1 == 2)+  assert "zigzag(100) = 200" (zigzagEncode 100 == 200)++  -- Verify zigzag of small negatives uses fewer bytes than plain int encoding+  -- -1 as Int32 on wire (varint) is 10 bytes (sign-extended to Word64)+  -- -1 as zigzag -> 1 -> 1 byte+  let plainNeg1Bytes = BS.length $ runProtoBuilder (protoEncodeValue @Int32 (-1))+      zigzagNeg1 = zigzagEncode (-1)+      zigzagVarintSz n+        | n < 0x80       = 1+        | n < 0x4000     = 2+        | otherwise      = 3+  assert "zigzag(-1) more compact than plain Int32(-1)"+    (zigzagVarintSz zigzagNeg1 < plainNeg1Bytes)+++-- ===================================================================+-- 30. Large message test+-- ===================================================================++testLargeMessage :: IO ()+testLargeMessage = do+  putStrLn "=== Large message test ==="++  -- Create a message with a 10KB Text field and a 100-element repeated Int32 list+  let bigText = T.replicate 10000 "a"  -- 10KB text+      nums = map fromIntegral [1..100 :: Int] :: [Int32]+      msg = WithRepeatedInt (Field bigText) (Field nums)+      bs = encode msg+  case decode @WithRepeatedInt bs of+    Right msg' -> do+      assert "large message roundtrip" (msg == msg')+      assert "large text preserved" (T.length (unField (riName msg')) == 10000)+      assert "repeated list length preserved" (length (unField (riNums msg')) == 100)+    Left err -> error $ "FAIL: large message roundtrip: " ++ show err+++-- ===================================================================+-- 31. Wire compatibility with proto3 spec+-- ===================================================================++-- | Equivalent of:+-- message TestCompat {+--   string name = 1;+--   int32 id = 2;+--   bool active = 3;+-- }+data TestCompat = TestCompat+  { tcName   :: Field 1 Text+  , tcId     :: Field 2 Int32+  , tcActive :: Field 3 Bool+  } deriving (Show, Eq, Generic)++instance ProtoMessage TestCompat++testWireCompatibility :: IO ()+testWireCompatibility = do+  putStrLn "=== Wire compatibility with proto3 spec ==="++  let msg = TestCompat (Field "alice") (Field 42) (Field True)+      encoded = encode msg++  -- Expected wire bytes computed from proto3 spec:+  -- Field 1 (string): tag=0x0A (field 1, wire type 2), length=5, "alice"+  -- Field 2 (int32):  tag=0x10 (field 2, wire type 0), varint 42 = 0x2A+  -- Field 3 (bool):   tag=0x18 (field 3, wire type 0), varint 1 = 0x01+  let expected = BS.pack [0x0A, 0x05, 0x61, 0x6C, 0x69, 0x63, 0x65, 0x10, 0x2A, 0x18, 0x01]++  assert "wire compat: encode matches proto3 spec bytes" (encoded == expected)++  -- Reverse: decode known bytes and verify values+  case decode @TestCompat expected of+    Right msg' -> do+      assert "wire compat: decode name"   (unField (tcName msg') == "alice")+      assert "wire compat: decode id"     (unField (tcId msg') == 42)+      assert "wire compat: decode active" (unField (tcActive msg') == True)+    Left err -> error $ "FAIL: wire compat decode: " ++ show err+++-- ===================================================================+-- 31b. Negative Int32 wire compatibility+-- ===================================================================++testNegativeInt32Wire :: IO ()+testNegativeInt32Wire = do+  putStrLn "=== Negative Int32 wire compatibility ==="++  -- Proto3 encodes negative int32 as 10-byte varint (sign-extended to 64 bits).+  -- Simple { sName = Field "test", sAge = Field (-1) }+  -- Field 1 (Text "test"): tag = 0x0A (field 1, wire type 2), length = 4, "test" = 74 65 73 74+  -- Field 2 (Int32 -1):    tag = 0x10 (field 2, wire type 0),+  --   value = varint(0xFFFFFFFFFFFFFFFF) = FF FF FF FF FF FF FF FF FF 01 (10 bytes)+  let msg = Simple (Field "test") (Field (-1))+      encoded = encode msg+      expected = BS.pack+        [ 0x0A, 0x04, 0x74, 0x65, 0x73, 0x74  -- field 1: "test"+        , 0x10                                  -- field 2: tag+        , 0xFF, 0xFF, 0xFF, 0xFF, 0xFF          -- 10-byte varint for -1+        , 0xFF, 0xFF, 0xFF, 0xFF, 0x01          -- (sign-extended to 64 bits)+        ]+  assert "negative int32: encode matches proto3 spec" (encoded == expected)++  -- Reverse: decode known bytes+  case decode @Simple expected of+    Right msg' -> do+      assert "negative int32: decode name" (unField (sName msg') == "test")+      assert "negative int32: decode age" (unField (sAge msg') == -1)+    Left err -> error $ "FAIL: negative int32 decode: " ++ show err+++-- ===================================================================+-- 31c. Bool field wire format+-- ===================================================================++testBoolWireFormat :: IO ()+testBoolWireFormat = do+  putStrLn "=== Bool field wire format ==="++  -- true encodes as varint 1; false is omitted (proto3 default)+  -- AllDefaults { dName = "", dAge = 0, dFlag = True }+  -- name="" -> skipped, age=0 -> skipped+  -- field 3 (Bool True): tag = 0x18 (field 3, wire type 0), value = varint 1 = 0x01+  let msgTrue = AllDefaults (Field "") (Field 0) (Field True)+      encodedTrue = encode msgTrue+      expectedTrue = BS.pack [0x18, 0x01]+  assert "bool true: encode matches proto3 spec" (encodedTrue == expectedTrue)++  case decode @AllDefaults expectedTrue of+    Right msg' -> do+      assert "bool true: decode flag" (unField (dFlag msg') == True)+      assert "bool true: decode name default" (unField (dName msg') == "")+      assert "bool true: decode age default" (unField (dAge msg') == 0)+    Left err -> error $ "FAIL: bool true decode: " ++ show err++  -- false is proto3 default -> all-default message encodes to empty+  let msgFalse = AllDefaults (Field "") (Field 0) (Field False)+      encodedFalse = encode msgFalse+  assert "bool false: omitted on wire (empty bytes)" (BS.null encodedFalse)+++-- ===================================================================+-- 31d. Empty string field wire format+-- ===================================================================++testEmptyStringWire :: IO ()+testEmptyStringWire = do+  putStrLn "=== Empty string field wire format ==="++  -- Proto3: "" is default for string, so present-but-empty is omitted.+  -- Simple { sName = "", sAge = 42 }+  -- name="" -> skipped, age=42 -> tag=0x10, varint 42=0x2A+  let msg = Simple (Field "") (Field 42)+      encoded = encode msg+      expected = BS.pack [0x10, 0x2A]+  assert "empty string: omitted on wire" (encoded == expected)++  case decode @Simple expected of+    Right msg' -> do+      assert "empty string: decode name defaults to ''" (unField (sName msg') == "")+      assert "empty string: decode age" (unField (sAge msg') == 42)+    Left err -> error $ "FAIL: empty string decode: " ++ show err+++-- ===================================================================+-- 31e. Varint edge cases (multi-byte boundaries)+-- ===================================================================++testVarintEdgeCases :: IO ()+testVarintEdgeCases = do+  putStrLn "=== Varint edge cases ==="++  -- Value 128: 2-byte varint 0x80 0x01+  -- Simple { sName = "", sAge = 128 }+  -- name="" -> skipped, age=128 -> tag=0x10, varint [0x80, 0x01]+  let msg128 = Simple (Field "") (Field 128)+      encoded128 = encode msg128+      expected128 = BS.pack [0x10, 0x80, 0x01]+  assert "varint 128: 2-byte encoding" (encoded128 == expected128)++  case decode @Simple expected128 of+    Right msg' -> assert "varint 128: roundtrip" (unField (sAge msg') == 128)+    Left err -> error $ "FAIL: varint 128 decode: " ++ show err++  -- Value 16384: 3-byte varint 0x80 0x80 0x01+  -- Simple { sName = "", sAge = 16384 }+  let msg16384 = Simple (Field "") (Field 16384)+      encoded16384 = encode msg16384+      expected16384 = BS.pack [0x10, 0x80, 0x80, 0x01]+  assert "varint 16384: 3-byte encoding" (encoded16384 == expected16384)++  case decode @Simple expected16384 of+    Right msg' -> assert "varint 16384: roundtrip" (unField (sAge msg') == 16384)+    Left err -> error $ "FAIL: varint 16384 decode: " ++ show err+++-- ===================================================================+-- 31f. Nested message wire bytes+-- ===================================================================++testNestedMessageWire :: IO ()+testNestedMessageWire = do+  putStrLn "=== Nested message wire bytes ==="++  -- Person { pName = "Homer", pAddr = Just (Address { city = "NYC", addrZip = 100 }) }+  --+  -- Address submessage:+  --   field 1 (Text "NYC"): tag=0x0A, len=3, 4E 59 43+  --   field 2 (Int32 100):  tag=0x10, varint 100=0x64+  --   submessage bytes: 0A 03 4E 59 43 10 64 (7 bytes)+  --+  -- Person:+  --   field 1 (Text "Homer"): tag=0x0A, len=5, 48 6F 6D 65 72+  --   field 2 (submessage):   tag=0x12 (field 2, wire type 2), len=7, <submessage>+  let addr = Address (Field "NYC") (Field 100)+      person = Person (Field "Homer") (Field (Just addr))+      encoded = encode person+      expected = BS.pack+        [ 0x0A, 0x05, 0x48, 0x6F, 0x6D, 0x65, 0x72  -- field 1: "Homer"+        , 0x12, 0x07                                   -- field 2: tag + length 7+        , 0x0A, 0x03, 0x4E, 0x59, 0x43                -- submessage field 1: "NYC"+        , 0x10, 0x64                                   -- submessage field 2: 100+        ]+  assert "nested message: encode matches hand-computed bytes" (encoded == expected)++  case decode @Person expected of+    Right person' -> do+      assert "nested message: decode name" (unField (pName person') == "Homer")+      case unField (pAddr person') of+        Just addr' -> do+          assert "nested message: decode city" (unField (city addr') == "NYC")+          assert "nested message: decode zip" (unField (addrZip addr') == 100)+        Nothing -> error "FAIL: nested message decode: addr is Nothing"+    Left err -> error $ "FAIL: nested message wire decode: " ++ show err+++-- ===================================================================+-- 31g. Repeated field (unpacked) wire bytes+-- ===================================================================++testRepeatedFieldWire :: IO ()+testRepeatedFieldWire = do+  putStrLn "=== Repeated field (unpacked) wire bytes ==="++  -- WithList { wTags = ["ab", "cd"] }+  -- Each string gets its own tag (field 1, wire type 2 = 0x0A):+  --   "ab": tag=0x0A, len=2, 61 62+  --   "cd": tag=0x0A, len=2, 63 64+  let msg = WithList (Field ["ab", "cd"])+      encoded = encode msg+      expected = BS.pack+        [ 0x0A, 0x02, 0x61, 0x62  -- "ab"+        , 0x0A, 0x02, 0x63, 0x64  -- "cd"+        ]+  assert "repeated unpacked: encode matches hand-computed bytes" (encoded == expected)++  case decode @WithList expected of+    Right msg' -> assert "repeated unpacked: decode roundtrip"+                         (unField (wTags msg') == ["ab", "cd"])+    Left err -> error $ "FAIL: repeated unpacked decode: " ++ show err++  -- Verify that multiple entries for same field are correctly merged on decode+  -- Manually construct: "ab" entry, then "cd" entry, then "ef" entry+  let extraEntry = BS.pack [0x0A, 0x02, 0x65, 0x66]  -- "ef"+      extended = expected <> extraEntry+  case decode @WithList extended of+    Right msg' -> assert "repeated unpacked: merge 3 entries"+                         (unField (wTags msg') == ["ab", "cd", "ef"])+    Left err -> error $ "FAIL: repeated unpacked merge: " ++ show err+++-- ===================================================================+-- 32. Packed repeated field decoding+-- ===================================================================++data Packed = Packed+  { pScores :: Field 1 [Int32]+  } deriving (Show, Eq, Generic)++instance ProtoMessage Packed++testPackedRepeatedRoundtrip :: IO ()+testPackedRepeatedRoundtrip = do+  putStrLn "=== Packed repeated field decoding ==="++  -- Encode using packed format (single length-delimited blob)+  let scores = [10, 20, 30, 40, 50] :: [Int32]+      packedBytes = runProtoBuilder (encodePackedField (Field scores :: Field 1 [Int32]))+  -- Decode using Generics decoder (which now handles packed)+  case decode @Packed packedBytes of+    Right msg -> assert "packed repeated roundtrip" (unField (pScores msg) == scores)+    Left err -> error $ "FAIL: packed repeated roundtrip: " ++ show err++  -- Encode using unpacked format (each element individually tagged)+  let unpackedBytes = runProtoBuilder (encodeRepeatedField (Field scores :: Field 1 [Int32]))+  case decode @Packed unpackedBytes of+    Right msg -> assert "unpacked repeated roundtrip" (unField (pScores msg) == scores)+    Left err -> error $ "FAIL: unpacked repeated roundtrip: " ++ show err++  -- Empty packed field+  let emptyPacked = runProtoBuilder (encodePackedField (Field [] :: Field 1 [Int32]))+  case decode @Packed emptyPacked of+    Right msg -> assert "empty packed roundtrip" (unField (pScores msg) == [])+    Left err -> error $ "FAIL: empty packed roundtrip: " ++ show err+++-- ===================================================================+-- 33. Mixed packed/unpacked entries+-- ===================================================================++testMixedPackedUnpacked :: IO ()+testMixedPackedUnpacked = do+  putStrLn "=== Mixed packed/unpacked entries ==="++  -- Manually construct wire bytes with a packed blob AND individual entries+  -- for the same field number 1.+  -- First: unpacked entry for value 1+  let unpacked1 = runProtoBuilder (encodeRepeatedField (Field [1 :: Int32] :: Field 1 [Int32]))+  -- Second: packed blob for values [2, 3, 4]+  let packed234 = runProtoBuilder (encodePackedField (Field [2, 3, 4 :: Int32] :: Field 1 [Int32]))+  -- Third: unpacked entry for value 5+  let unpacked5 = runProtoBuilder (encodeRepeatedField (Field [5 :: Int32] :: Field 1 [Int32]))+  -- Concatenate them (this is valid proto3: decoder must merge all entries)+  let mixed = unpacked1 <> packed234 <> unpacked5+  case decode @Packed mixed of+    Right msg -> assert "mixed packed/unpacked decodes all values"+                        (unField (pScores msg) == [1, 2, 3, 4, 5])+    Left err -> error $ "FAIL: mixed packed/unpacked: " ++ show err+++-- ===================================================================+-- 34. ProtoMap field roundtrip+-- ===================================================================++data WithMap = WithMap+  { wmLabels :: Field 1 (ProtoMap Text Int32)+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithMap++testMapRoundtrip :: IO ()+testMapRoundtrip = do+  putStrLn "=== ProtoMap field roundtrip ==="++  -- Non-empty map+  let m = Map.fromList [("alpha", 1), ("beta", 2), ("gamma", 3)]+      msg = WithMap (Field (ProtoMap m))+  case decode (encode msg) of+    Right msg' -> assert "map roundtrip" (msg == msg')+    Left err -> error $ "FAIL: map roundtrip: " ++ show err+++-- ===================================================================+-- 35. Empty map+-- ===================================================================++testEmptyMap :: IO ()+testEmptyMap = do+  putStrLn "=== Empty map ==="++  let msg = WithMap (Field (ProtoMap Map.empty))+      bs = encode msg+  -- Empty map should encode to empty bytes (no entries)+  assert "empty map encodes to empty bytes" (BS.null bs)++  case decode @WithMap bs of+    Right msg' -> assert "empty map roundtrip" (msg == msg')+    Left err -> error $ "FAIL: empty map roundtrip: " ++ show err+++-- ===================================================================+-- 36. Map with multiple entry types+-- ===================================================================++data WithMaps = WithMaps+  { wmStrStr :: Field 1 (ProtoMap Text Text)+  , wmStrInt :: Field 2 (ProtoMap Text Int32)+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithMaps++testMultipleMaps :: IO ()+testMultipleMaps = do+  putStrLn "=== Multiple map fields ==="++  let msg = WithMaps+              (Field (ProtoMap (Map.fromList [("key1", "val1"), ("key2", "val2")])))+              (Field (ProtoMap (Map.fromList [("count", 42)])))+  case decode (encode msg) of+    Right msg' -> assert "multiple maps roundtrip" (msg == msg')+    Left err -> error $ "FAIL: multiple maps roundtrip: " ++ show err+++-- ===================================================================+-- Protoc cross-validation: message types matching test.proto+-- ===================================================================++-- | Matches test.SimpleMsg in test.proto+data ProtoSimpleMsg = ProtoSimpleMsg+  { psName   :: Field 1 Text+  , psAge    :: Field 2 Int32+  , psActive :: Field 3 Bool+  } deriving (Show, Eq, Generic)++instance ProtoMessage ProtoSimpleMsg++-- | Matches test.NestedMsg in test.proto+data ProtoNestedMsg = ProtoNestedMsg+  { pnTitle  :: Field 1 Text+  , pnAuthor :: Field 2 (Maybe ProtoSimpleMsg)+  } deriving (Show, Eq, Generic)++instance ProtoMessage ProtoNestedMsg++-- | Matches test.RepeatedMsg in test.proto+data ProtoRepeatedMsg = ProtoRepeatedMsg+  { prValues :: Field 1 [Int32]+  , prTags   :: Field 2 [Text]+  } deriving (Show, Eq, Generic)++instance ProtoMessage ProtoRepeatedMsg++-- | Matches test.MapMsg in test.proto+data ProtoMapMsg = ProtoMapMsg+  { pmScores :: Field 1 (ProtoMap Text Int32)+  } deriving (Show, Eq, Generic)++instance ProtoMessage ProtoMapMsg+++-- ===================================================================+-- Protoc cross-validation: helpers+-- ===================================================================++-- | Check if protoc is available on the system.+hasProtoc :: IO Bool+hasProtoc = do+  result <- try @SomeException (readProcess "protoc" ["--version"] "")+  pure (isRight result)++-- | Pipe binary bytes to protoc --decode, returning the text-format output.+protocDecode :: String -> ByteString -> IO String+protocDecode msgName bytes = do+  let cp = (proc "protoc" ["--decode=" ++ msgName, "--proto_path=test", "test.proto"])+        { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }+  (Just hin, Just hout, Just _herr, ph) <- createProcess cp+  hSetBinaryMode hin True+  BS.hPut hin bytes+  hFlush hin+  hClose hin+  output <- hGetContents hout+  _ <- waitForProcess ph+  pure output++-- | Pipe text-format to protoc --encode, returning the binary output.+protocEncode :: String -> String -> IO ByteString+protocEncode msgName textFormat = do+  let cp = (proc "protoc" ["--encode=" ++ msgName, "--proto_path=test", "test.proto"])+        { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }+  (Just hin, Just hout, Just _herr, ph) <- createProcess cp+  hSetBinaryMode hout True+  hPutStr' hin textFormat+  hFlush hin+  hClose hin+  output <- BS.hGetContents hout+  _ <- waitForProcess ph+  pure output+  where+    hPutStr' h s = do+      let bs = BS.pack (map (toEnum . fromEnum) s)+      BS.hPut h bs+++-- ===================================================================+-- Protoc cross-validation: Test A — Our encode -> protoc decode+-- ===================================================================++testProtocDecodeSimple :: IO ()+testProtocDecodeSimple = do+  putStrLn "=== Protoc cross-validation: our encode -> protoc decode (SimpleMsg) ==="+  let msg = ProtoSimpleMsg (Field "alice") (Field 30) (Field True)+      bytes = Spire.Protobuf.encode msg+  output <- protocDecode "test.SimpleMsg" bytes+  assert "protoc decode: has name" ("name: \"alice\"" `isInfixOf` output)+  assert "protoc decode: has age" ("age: 30" `isInfixOf` output)+  assert "protoc decode: has active" ("active: true" `isInfixOf` output)++testProtocDecodeNested :: IO ()+testProtocDecodeNested = do+  putStrLn "=== Protoc cross-validation: our encode -> protoc decode (NestedMsg) ==="+  let author = ProtoSimpleMsg (Field "bob") (Field 25) (Field False)+      msg = ProtoNestedMsg (Field "My Article") (Field (Just author))+      bytes = Spire.Protobuf.encode msg+  output <- protocDecode "test.NestedMsg" bytes+  assert "protoc decode nested: has title" ("title: \"My Article\"" `isInfixOf` output)+  assert "protoc decode nested: has author name" ("name: \"bob\"" `isInfixOf` output)+  assert "protoc decode nested: has author age" ("age: 25" `isInfixOf` output)++testProtocDecodeRepeated :: IO ()+testProtocDecodeRepeated = do+  putStrLn "=== Protoc cross-validation: our encode -> protoc decode (RepeatedMsg) ==="+  let msg = ProtoRepeatedMsg (Field [10, 20, 30]) (Field ["hello", "world"])+      bytes = Spire.Protobuf.encode msg+  output <- protocDecode "test.RepeatedMsg" bytes+  assert "protoc decode repeated: has values" ("values: 10" `isInfixOf` output)+  assert "protoc decode repeated: has value 30" ("values: 30" `isInfixOf` output)+  assert "protoc decode repeated: has tag hello" ("tags: \"hello\"" `isInfixOf` output)+  assert "protoc decode repeated: has tag world" ("tags: \"world\"" `isInfixOf` output)++testProtocDecodeMap :: IO ()+testProtocDecodeMap = do+  putStrLn "=== Protoc cross-validation: our encode -> protoc decode (MapMsg) ==="+  let msg = ProtoMapMsg (Field (ProtoMap (Map.fromList [("alice", 100), ("bob", 200)])))+      bytes = Spire.Protobuf.encode msg+  output <- protocDecode "test.MapMsg" bytes+  assert "protoc decode map: has alice" ("key: \"alice\"" `isInfixOf` output)+  assert "protoc decode map: has alice score" ("value: 100" `isInfixOf` output)+  assert "protoc decode map: has bob" ("key: \"bob\"" `isInfixOf` output)+  assert "protoc decode map: has bob score" ("value: 200" `isInfixOf` output)+++-- ===================================================================+-- Protoc cross-validation: Test B — protoc encode -> our decode+-- ===================================================================++testProtocEncodeSimple :: IO ()+testProtocEncodeSimple = do+  putStrLn "=== Protoc cross-validation: protoc encode -> our decode (SimpleMsg) ==="+  let textFormat = unlines+        [ "name: \"bob\""+        , "age: 25"+        , "active: false"+        ]+  bytes <- protocEncode "test.SimpleMsg" textFormat+  case Spire.Protobuf.decode bytes of+    Right msg -> do+      assert "protoc encode: name matches" (unField (psName msg) == "bob")+      assert "protoc encode: age matches" (unField (psAge msg) == 25)+      assert "protoc encode: active matches" (unField (psActive msg) == False)+    Left err -> error $ "FAIL: protoc encode simple decode: " ++ show err++testProtocEncodeNested :: IO ()+testProtocEncodeNested = do+  putStrLn "=== Protoc cross-validation: protoc encode -> our decode (NestedMsg) ==="+  let textFormat = unlines+        [ "title: \"Research Paper\""+        , "author {"+        , "  name: \"carol\""+        , "  age: 35"+        , "  active: true"+        , "}"+        ]+  bytes <- protocEncode "test.NestedMsg" textFormat+  case Spire.Protobuf.decode @ProtoNestedMsg bytes of+    Right msg -> do+      assert "protoc encode nested: title matches" (unField (pnTitle msg) == "Research Paper")+      case unField (pnAuthor msg) of+        Just author -> do+          assert "protoc encode nested: author name" (unField (psName author) == "carol")+          assert "protoc encode nested: author age" (unField (psAge author) == 35)+          assert "protoc encode nested: author active" (unField (psActive author) == True)+        Nothing -> error "FAIL: protoc encode nested: author is Nothing"+    Left err -> error $ "FAIL: protoc encode nested decode: " ++ show err++testProtocEncodeRepeated :: IO ()+testProtocEncodeRepeated = do+  putStrLn "=== Protoc cross-validation: protoc encode -> our decode (RepeatedMsg) ==="+  let textFormat = unlines+        [ "values: 5"+        , "values: 10"+        , "values: 15"+        , "tags: \"foo\""+        , "tags: \"bar\""+        ]+  bytes <- protocEncode "test.RepeatedMsg" textFormat+  case Spire.Protobuf.decode @ProtoRepeatedMsg bytes of+    Right msg -> do+      assert "protoc encode repeated: values match" (unField (prValues msg) == [5, 10, 15])+      assert "protoc encode repeated: tags match" (unField (prTags msg) == ["foo", "bar"])+    Left err -> error $ "FAIL: protoc encode repeated decode: " ++ show err+++-- ===================================================================+-- Protoc cross-validation: Test C — roundtrip (our encode -> protoc -> our decode)+-- ===================================================================++testProtocRoundtrip :: IO ()+testProtocRoundtrip = do+  putStrLn "=== Protoc cross-validation: full roundtrip ==="+  -- Encode with our library, decode to text with protoc, re-encode with protoc,+  -- decode with our library — should get the same message back.+  let original = ProtoSimpleMsg (Field "roundtrip") (Field 99) (Field True)+      bytes1 = Spire.Protobuf.encode original+  -- Our bytes -> protoc text+  textOutput <- protocDecode "test.SimpleMsg" bytes1+  -- protoc text -> protoc bytes+  bytes2 <- protocEncode "test.SimpleMsg" textOutput+  -- protoc bytes -> our decode+  case Spire.Protobuf.decode @ProtoSimpleMsg bytes2 of+    Right decoded -> assert "full roundtrip: message preserved" (decoded == original)+    Left err -> error $ "FAIL: full roundtrip decode: " ++ show err+++-- ===================================================================+-- Protoc cross-validation: Test D — default values (empty message)+-- ===================================================================++testProtocDefaults :: IO ()+testProtocDefaults = do+  putStrLn "=== Protoc cross-validation: default/empty message ==="+  -- Encode a default (all-zeros) message with our library+  let msg = ProtoSimpleMsg (Field "") (Field 0) (Field False)+      bytes = Spire.Protobuf.encode msg+  -- Proto3: default values are not encoded on the wire, so the output+  -- should be empty (protoc --decode shows nothing for default values)+  assert "default msg: empty encoding" (BS.null bytes)+  -- Decode an empty message from protoc+  bytes2 <- protocEncode "test.SimpleMsg" ""+  case Spire.Protobuf.decode @ProtoSimpleMsg bytes2 of+    Right decoded -> do+      assert "protoc default: name is empty" (unField (psName decoded) == "")+      assert "protoc default: age is 0" (unField (psAge decoded) == 0)+      assert "protoc default: active is false" (unField (psActive decoded) == False)+    Left err -> error $ "FAIL: protoc default decode: " ++ show err+++-- ===================================================================+-- Protoc cross-validation: entry point+-- ===================================================================++testProtocCrossValidation :: IO ()+testProtocCrossValidation = do+  ok <- hasProtoc+  if ok+    then do+      testProtocDecodeSimple+      testProtocDecodeNested+      testProtocDecodeRepeated+      testProtocDecodeMap+      testProtocEncodeSimple+      testProtocEncodeNested+      testProtocEncodeRepeated+      testProtocRoundtrip+      testProtocDefaults+    else putStrLn "  SKIP: protoc not found (install with: brew install protobuf)"+++-- ===================================================================+-- Main+-- ===================================================================++main :: IO ()+main = do+  putStrLn "spire-protobuf unit tests"+  putStrLn (replicate 40 '-')++  testVarintRoundtrip+  testZigzagRoundtrip+  testFixed32Roundtrip+  testFixed64Roundtrip+  testFloatRoundtrip+  testDoubleRoundtrip+  testTagEncodeDecode+  testLengthDelimitedRoundtrip+  testSkipField+  testEncodeInt32+  testEncodeBool+  testEncodeText+  testEncodeByteString+  testEncodeOptionalField+  testEncodeRepeatedField+  testProtoBuilderLength+  testDecodeInt32+  testDecodeText+  testDecodeByteString+  testParseFields+  testUnknownFields+  testSimpleRoundtrip+  testOptionalRoundtrip+  testRepeatedRoundtrip+  testDefaultsEncoding+  testMissingFieldsDefault+  testNestedMessageRoundtrip+  testOutOfOrderDecoding+  testDuplicateFieldLastWins+  testMalformedInput+  testOverlongVarintRejection+  testZigzagNegativeEfficiency+  testLargeMessage+  testWireCompatibility+  testNegativeInt32Wire+  testBoolWireFormat+  testEmptyStringWire+  testVarintEdgeCases+  testNestedMessageWire+  testRepeatedFieldWire+  testPackedRepeatedRoundtrip+  testMixedPackedUnpacked+  testMapRoundtrip+  testEmptyMap+  testMultipleMaps+  testProtocCrossValidation++  putStrLn (replicate 40 '-')+  putStrLn "All tests passed!"

@@ -0,0 +1,253 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Main (main) where++import qualified Data.ByteString as BS+import Data.Int (Int32)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import Data.Word (Word64)+import GHC.Generics (Generic)++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Spire.Protobuf+import Spire.Protobuf.Wire (encodeFixed32, encodeFixed64, decodeVarint, decodeFixed32,+                            decodeFixed64, encodeLengthDelimited, decodeLengthDelimited,+                            zigzagEncode, zigzagDecode)+import Spire.Protobuf.Encode (runProtoBuilder, ProtoBuilder(..), encodePackedField)+++-- ===================================================================+-- Test message types+-- ===================================================================++data Simple = Simple+  { sName :: Field 1 Text+  , sAge  :: Field 2 Int32+  } deriving (Show, Eq, Generic)++instance ProtoMessage Simple++data WithOpt = WithOpt+  { wName :: Field 1 Text+  , wNick :: Field 2 (Maybe Text)+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithOpt++data AllDefaults = AllDefaults+  { dName :: Field 1 Text+  , dAge  :: Field 2 Int32+  , dFlag :: Field 3 Bool+  } deriving (Show, Eq, Generic)++instance ProtoMessage AllDefaults++data Address = Address+  { city :: Field 1 Text+  , addrZip :: Field 2 Int32+  } deriving (Show, Eq, Generic)++instance ProtoMessage Address++data Person = Person+  { pName :: Field 1 Text+  , pAddr :: Field 2 (Maybe Address)+  } deriving (Show, Eq, Generic)++instance ProtoMessage Person+++-- ===================================================================+-- Generators+-- ===================================================================++genText :: Gen Text+genText = Gen.text (Range.linear 0 200) Gen.unicode++genSimple :: Gen Simple+genSimple = Simple+  <$> (Field <$> genText)+  <*> (Field <$> Gen.int32 Range.linearBounded)++genWithOpt :: Gen WithOpt+genWithOpt = WithOpt+  <$> (Field <$> genText)+  <*> (Field <$> Gen.maybe genText)++genAddress :: Gen Address+genAddress = Address+  <$> (Field <$> genText)+  <*> (Field <$> Gen.int32 Range.linearBounded)++genPerson :: Gen Person+genPerson = Person+  <$> (Field <$> genText)+  <*> (Field <$> Gen.maybe genAddress)+++-- ===================================================================+-- Properties+-- ===================================================================++-- | For any Word64, decoding the varint encoding gives back the original.+prop_varintRoundtrip :: Property+prop_varintRoundtrip = property $ do+  n <- forAll $ Gen.word64 Range.linearBounded+  let bs = runProtoBuilder (protoEncodeValue @Word64 n)+  case decodeVarint bs of+    Just (v, rest) -> do+      v === n+      assert (BS.null rest)+    Nothing -> failure++-- | For any Int64, zigzagDecode (zigzagEncode n) == n.+prop_zigzagRoundtrip :: Property+prop_zigzagRoundtrip = property $ do+  n <- forAll $ Gen.int64 Range.linearBounded+  zigzagDecode (zigzagEncode n) === n++-- | For any Word32, fixed32 roundtrip works.+prop_fixed32Roundtrip :: Property+prop_fixed32Roundtrip = property $ do+  n <- forAll $ Gen.word32 Range.linearBounded+  let bs = runProtoBuilder (ProtoBuilder 4 (encodeFixed32 n))+  case decodeFixed32 bs of+    Just (v, rest) -> do+      v === n+      assert (BS.null rest)+    Nothing -> failure++-- | For any Word64, fixed64 roundtrip works.+prop_fixed64Roundtrip :: Property+prop_fixed64Roundtrip = property $ do+  n <- forAll $ Gen.word64 Range.linearBounded+  let bs = runProtoBuilder (ProtoBuilder 8 (encodeFixed64 n))+  case decodeFixed64 bs of+    Just (v, rest) -> do+      v === n+      assert (BS.null rest)+    Nothing -> failure++-- | For any ByteString, length-delimited roundtrip works.+prop_lengthDelimitedRoundtrip :: Property+prop_lengthDelimitedRoundtrip = property $ do+  input <- forAll $ Gen.bytes (Range.linear 0 5000)+  let len = BS.length input+      varintLen n+        | n < 0x80       = 1+        | n < 0x4000     = 2+        | n < 0x200000   = 3+        | otherwise      = 4+      totalLen = varintLen len + len+      bs = runProtoBuilder (ProtoBuilder totalLen (encodeLengthDelimited input))+  case decodeLengthDelimited bs of+    Just (v, rest) -> do+      v === input+      assert (BS.null rest)+    Nothing -> failure++-- | For a Simple message with random name/age, decode (encode msg) == Right msg.+prop_messageRoundtrip :: Property+prop_messageRoundtrip = property $ do+  msg <- forAll genSimple+  decode (encode msg) === Right msg++-- | For WithOpt with random Maybe Text, roundtrip works.+prop_optionalFieldRoundtrip :: Property+prop_optionalFieldRoundtrip = property $ do+  msg <- forAll genWithOpt+  decode (encode msg) === Right msg++-- | A message with all-default values encodes to empty bytes.+prop_defaultsProduceEmptyEncoding :: Property+prop_defaultsProduceEmptyEncoding = property $ do+  let msg = AllDefaults (Field "") (Field 0) (Field False)+  encode msg === BS.empty++-- | For any random Person with random Address, roundtrip succeeds.+prop_nestedMessageRoundtrip :: Property+prop_nestedMessageRoundtrip = property $ do+  msg <- forAll genPerson+  decode (encode msg) === Right msg++-- | For any random ByteString, decode @Simple never crashes (always returns Left or Right).+prop_malformedInputDoesNotCrash :: Property+prop_malformedInputDoesNotCrash = property $ do+  bs <- forAll $ Gen.bytes (Range.linear 0 500)+  case decode @Simple bs of+    Left _  -> success+    Right _ -> success++-- | For any Int64, zigzag encode/decode roundtrips.+prop_zigzagInt64Roundtrip :: Property+prop_zigzagInt64Roundtrip = property $ do+  n <- forAll $ Gen.int64 Range.linearBounded+  zigzagDecode (zigzagEncode n) === n+++-- ===================================================================+-- Packed repeated field properties+-- ===================================================================++data Packed = Packed+  { pScores :: Field 1 [Int32]+  } deriving (Show, Eq, Generic)++instance ProtoMessage Packed++-- | For any [Int32], packed encoding then Generics decode roundtrips.+prop_packedRoundtrip :: Property+prop_packedRoundtrip = property $ do+  xs <- forAll $ Gen.list (Range.linear 0 100) (Gen.int32 Range.linearBounded)+  let packed = runProtoBuilder (encodePackedField (Field xs :: Field 1 [Int32]))+  decode @Packed packed === Right (Packed (Field xs))+++-- ===================================================================+-- Map field properties+-- ===================================================================++data WithMap = WithMap+  { wmLabels :: Field 1 (ProtoMap Text Int32)+  } deriving (Show, Eq, Generic)++instance ProtoMessage WithMap++genProtoMap :: Gen (ProtoMap Text Int32)+genProtoMap = do+  kvs <- Gen.list (Range.linear 0 20)+    ((,) <$> genText <*> Gen.int32 Range.linearBounded)+  pure (ProtoMap (Map.fromList kvs))++-- | For any Map Text Int32, encode then decode roundtrips.+prop_mapRoundtrip :: Property+prop_mapRoundtrip = property $ do+  m <- forAll genProtoMap+  let msg = WithMap (Field m)+  decode (encode msg) === Right msg+++-- ===================================================================+-- Main (TemplateHaskell discovery)+-- ===================================================================++tests :: IO Bool+tests = checkParallel $$(discover)++main :: IO ()+main = do+  ok <- tests+  if ok+    then putStrLn "All property tests passed!"+    else do+      putStrLn "Some property tests FAILED!"+      error "Property test failure"

@@ -0,0 +1,22 @@+syntax = "proto3";+package test;++message SimpleMsg {+  string name = 1;+  int32 age = 2;+  bool active = 3;+}++message NestedMsg {+  string title = 1;+  SimpleMsg author = 2;+}++message RepeatedMsg {+  repeated int32 values = 1;+  repeated string tags = 2;+}++message MapMsg {+  map<string, int32> scores = 1;+}