awakesecurity · j6carey · Apr 14, 2026 · Apr 14, 2026 · Apr 14, 2026
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,3 +1,10 @@
+# 0.9.5
+* [#305](https://github.com/awakesecurity/proto3-suite/pull/305) Avoid unpacked packed fields
+  * The new system of typed builders exploited parser behavior that is required
+    by the protobuf standard but not yet implemented by `proto3-suite`, causing
+    decoding errors when the decoder is `proto3-suite`.  This change avoids that
+    incompatibility and expands round-trip testing to cover more scenarios.
+
 # 0.9.4
 * [#289](https://github.com/awakesecurity/proto3-suite/pull/289) Support optional fields
   * Support optional fields (outside of a `oneof`).  Such fields are allowed

diff --git a/proto3-suite.cabal b/proto3-suite.cabal
@@ -1,6 +1,6 @@
 cabal-version:       2.2
 name:                proto3-suite
-version:             0.9.4
+version:             0.9.5
 synopsis:            A higher-level API to the proto3-wire library
 description:
   This library provides a higher-level API to <https://github.com/awakesecurity/proto3-wire the `proto3-wire` library>
@@ -22,12 +22,12 @@ category:            Codec
 build-type:          Simple
 
 data-files:
-  test-files/*.bin 
-  tests/encode.sh 
+  test-files/*.bin
+  tests/encode.sh
   tests/decode.sh
 
 extra-source-files:
-  CHANGELOG.md, 
+  CHANGELOG.md,
   gen/.gitignore
 
 flag dhall
@@ -53,7 +53,7 @@ flag attoparsec-aeson
 
 flag development
   Description: Enable development-specific options.
-  Default:     False 
+  Default:     False
   Manual:      True
 
 source-repository head
@@ -75,7 +75,7 @@ common common
     , proto3-wire >= 1.4.6 && < 1.5
 
   ghc-options:
-    -O2 
+    -O2
     -Wall
 
 library
@@ -91,7 +91,7 @@ library
     build-depends:
       swagger2 >=2.1.6 && <2.9
 
-    cpp-options:       
+    cpp-options:
       -DSWAGGER
 
     exposed-modules:
@@ -103,7 +103,7 @@ library
     else
       hs-source-dirs: src/no-swagger-wrapper-format
 
-  exposed-modules:     
+  exposed-modules:
     Proto3.Suite
     Proto3.Suite.Class
     Proto3.Suite.DotProto
@@ -131,7 +131,7 @@ library
     Proto3.Suite.Form.Encode.Core
     Turtle.Compat
 
-  build-depends:       
+  build-depends:
       aeson >= 1.1.1.0 && < 2.3
     , aeson-pretty
     , attoparsec >= 0.13.0.1
@@ -259,7 +259,7 @@ executable compile-proto-file
   hs-source-dirs:   tools/compile-proto-file
   default-language: Haskell2010
 
-  build-depends: 
+  build-depends:
       base >=4.15 && <5.0
     , ghc-lib-parser
     , optparse-applicative
@@ -277,7 +277,7 @@ executable canonicalize-proto-file
   main-is:          Main.hs
   hs-source-dirs:   tools/canonicalize-proto-file
 
-  build-depends:       
+  build-depends:
       containers >=0.5 && <0.8
     , mtl >=2.2 && <2.4
     , optparse-generic

diff --git a/src/Proto3/Suite/Form/Encode/Core.hs b/src/Proto3/Suite/Form/Encode/Core.hs
@@ -497,23 +497,29 @@ instance ( ToRepeated c e
          ) =>
          FieldForm ('Repeated 'Packed) protoType c
   where
-    fieldForm _ ty !fn (toRepeated -> !xs@(ReverseRepeated prediction reversed)) =
-        case prediction of
-          Just count
-            | 2 <= count -> packedFieldForm ty fn xs  -- multiple packed elements
-            | otherwise -> fieldForm (proxy# :: Proxy# ('Repeated 'Unpacked)) ty fn xs  -- 0 or 1
-          Nothing -> case foldr singletonOp Empty reversed of
-            Empty -> mempty  -- 0 elements can be expressed implicitly
-            Singleton x -> fieldForm (proxy# :: Proxy# 'Optional) ty fn (Identity x) -- unpacked
-            Multiple -> packedFieldForm ty fn xs  -- multiple packed elements
+    fieldForm _ ty !fn (toRepeated -> !xs@(ReverseRepeated prediction reversed))
+        | isEmpty = mempty  -- 0 elements can be expressed implicitly
+        | otherwise = packedFieldForm ty fn xs  -- at least one packed element
+            -- From <https://protobuf.dev/programming-guides/encoding/>, "Repeated Elements":
+            --
+            --   "Protocol buffer parsers must be able to parse repeated fields
+            --    that were compiled as packed as if they were not packed, and
+            --    vice versa. This permits adding [packed=true] to existing
+            --    fields in a forward- and backward-compatible way."
+            --
+            -- Therefore in principle we could save one octet by using unpacked
+            -- format for a repeated field containing exactly one element.
+            --
+            -- But at present the @proto3-suite@ decoder rejects unpacked format
+            -- when parsing a repeated field it expects to be packed.  And even
+            -- after we improve compatibility, saving just one octet might not
+            -- justify a larger and perhaps slower generated encoder.
       where
-        singletonOp :: a -> Singleton a -> Singleton a
-        singletonOp x Empty = Singleton x
-        singletonOp _ _ = Multiple
+        isEmpty = case prediction of
+          Just count -> count <= 0
+          Nothing -> null reversed
     {-# INLINE fieldForm #-}
 
-data Singleton a = Empty | Singleton a | Multiple
-
 instance FieldForm 'Optional ('Message inner) (Identity (MessageEncoder inner))
   where
     fieldForm _ _ !fn (Identity e) = Encode.embedded fn (untypedMessageEncoder e)

diff --git a/tests/TestCodeGen.hs b/tests/TestCodeGen.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -82,9 +83,14 @@ pythonInteroperation logger = testGroup "Python interoperation" $ do
   tt <- ["Data.Text.Lazy.Text", "Data.Text.Text", "Data.Text.Short.ShortText"]
   format <- ["Binary", "Jsonpb"]
   testEncode <- [True, False]
+  testDecode <- [False, True]
   direct <- [False, True]
   guard $ not direct || (testEncode && format == "Binary")
-  let f = if testEncode then simpleEncodeDotProto direct else simpleDecodeDotProto
+  f <- if
+         | testEncode, testDecode -> [roundTripDotProto direct]
+         | testEncode -> [simpleEncodeDotProto direct]
+         | testDecode -> [simpleDecodeDotProto]
+         | otherwise -> []
   pure @[] (f logger tt format)
 
 #ifdef SWAGGER
@@ -197,6 +203,7 @@ setPythonPath :: IO ()
 setPythonPath = Turtle.export "PYTHONPATH" .
   maybe pyTmpDir (\p -> pyTmpDir <> ":" <> p) =<< Turtle.need "PYTHONPATH"
 
+-- | Haskell encoder -> Python decoder.
 simpleEncodeDotProto :: Bool -> Logger -> String -> T.Text -> TestTree
 simpleEncodeDotProto direct logger chosenStringType format =
     testCase ("generate code for a simple .proto and then use it to encode messages" ++
@@ -206,13 +213,8 @@ simpleEncodeDotProto direct logger chosenStringType format =
          decodedStringType <- either die pure (parseStringType chosenStringType)
 
          compileTestDotProtos logger decodedStringType direct
-         -- Compile our generated encoder
-         let encodeCmd = "tests/encode.sh " <> hsTmpDir
-                           <> (if direct then " -DTYPE_LEVEL_FORMAT" else "")
-#if DHALL
-                           <> " -DDHALL"
-#endif
-         Turtle.shell encodeCmd empty >>= (@?= ExitSuccess)
+
+         compileHaskellEncoder direct
 
          -- The python test of encoding exits with a special error code to indicate
          -- all tests were successful.  When directly encoding without an intermediate
@@ -241,6 +243,7 @@ simpleEncodeDotProto direct logger chosenStringType format =
          Turtle.rmtree hsTmpDir
          Turtle.rmtree pyTmpDir
 
+-- | Python encoder -> Haskell decoder.
 simpleDecodeDotProto :: Logger -> String -> T.Text -> TestTree
 simpleDecodeDotProto logger chosenStringType format =
     testCase ("generate code for a simple .proto and then use it to decode messages" ++
@@ -249,12 +252,8 @@ simpleDecodeDotProto logger chosenStringType format =
          decodedStringType <- either die pure (parseStringType chosenStringType)
 
          compileTestDotProtos logger decodedStringType False
-         -- Compile our generated decoder
-         let decodeCmd = "tests/decode.sh " <> hsTmpDir
-#if DHALL
-                           <> " -DDHALL"
-#endif
-         Turtle.shell decodeCmd empty >>= (@?= ExitSuccess)
+
+         compileHaskellDecoder
 
          setPythonPath
          let cmd = "python tests/send_simple_dot_proto.py " <> format <> " | FORMAT=" <> format <> " " <> hsTmpDir <> "/simpleDecodeDotProto "
@@ -264,6 +263,43 @@ simpleDecodeDotProto logger chosenStringType format =
          Turtle.rmtree hsTmpDir
          Turtle.rmtree pyTmpDir
 
+-- | Haskell encoder -> Haskell decoder.
+roundTripDotProto :: Bool -> Logger -> String -> T.Text -> TestTree
+roundTripDotProto direct logger chosenStringType format =
+    testCase ("generate code for a simple .proto and then use it to encode and decode messages" ++
+              " with string type " ++ chosenStringType ++ " in format " ++ show format ++
+              (if direct then ", direct mode" else ", intermediate mode"))
+    $ do
+         decodedStringType <- either die pure (parseStringType chosenStringType)
+
+         compileTestDotProtos logger decodedStringType direct
+
+         compileHaskellEncoder direct
+
+         compileHaskellDecoder
+
+         let iterators :: [Iterator]
+             iterators
+               | direct = [minBound .. maxBound]
+               | otherwise = [minBound]  -- Just an unused placeholder
+             strippings :: [Stripping]
+             strippings
+               | direct = [minBound .. maxBound]
+               | otherwise = [minBound]  -- Just an unused placeholder
+         forM_ iterators $ \(iterator :: Iterator) -> do
+           forM_ strippings $ \(stripping :: Stripping) -> do
+             when direct $ do
+               putStrLn $ "        iterator: " ++ show iterator
+               putStrLn $ "        stripping: " ++ show stripping
+             let cmd = hsTmpDir <> "/simpleEncodeDotProto " <> format <>
+                       " " <> T.pack (show iterator) <> " " <> T.pack (show stripping) <>
+                       " | FORMAT=" <> format <> " " <> hsTmpDir <> "/simpleDecodeDotProto "
+             Turtle.shell cmd empty >>= (@?= ExitSuccess)
+
+         -- Not using bracket so that we can inspect the output to fix the tests
+         Turtle.rmtree hsTmpDir
+         Turtle.rmtree pyTmpDir
+
 -- * Helpers
 
 hsTmpDir, pyTmpDir :: IsString a => a
@@ -313,6 +349,25 @@ compileTestDotProtos logger decodedStringType typeLevel = do
 
   Turtle.touch (pyTmpDir Turtle.</> "__init__.py")
 
+-- | Compile our generated encoder
+compileHaskellEncoder :: Bool -> IO ()
+compileHaskellEncoder direct = do
+  let encodeCmd = "tests/encode.sh " <> hsTmpDir
+                    <> (if direct then " -DTYPE_LEVEL_FORMAT" else "")
+#if DHALL
+                    <> " -DDHALL"
+#endif
+  Turtle.shell encodeCmd empty >>= (@?= ExitSuccess)
+
+-- | Compile our generated decoder
+compileHaskellDecoder :: IO ()
+compileHaskellDecoder = do
+  let decodeCmd = "tests/decode.sh " <> hsTmpDir
+#if DHALL
+                    <> " -DDHALL"
+#endif
+  Turtle.shell decodeCmd empty >>= (@?= ExitSuccess)
+
 dotProtoTests :: TestTree
 dotProtoTests = testGroup "dotProto method tests"
   [ dotProtoTest @TestProto.Trivial