From 44f1d9ebb0f32a1239b1cb7a15268693e90df927 Mon Sep 17 00:00:00 2001 From: John Carey Date: Mon, 13 Apr 2026 22:34:56 -0700 Subject: [PATCH 1/2] 0.9.5: 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. --- CHANGELOG.md | 7 +++ proto3-suite.cabal | 22 ++++---- src/Proto3/Suite/Form/Encode/Core.hs | 34 +++++++----- tests/TestCodeGen.hs | 83 +++++++++++++++++++++++----- 4 files changed, 107 insertions(+), 39 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bd5a8b6c..28d0185e 100644 --- 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 index 90f49184..56b7aa0d 100644 --- 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 @@ -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 index 175cb739..81b5a667 100644 --- 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 , "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 index f8471ad1..b4d50118 100644 --- 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 From 231829237eaf13ab82f032254a415d0cfa9e883c Mon Sep 17 00:00:00 2001 From: John Carey Date: Mon, 13 Apr 2026 22:37:16 -0700 Subject: [PATCH 2/2] Fix markup syntax in CHANGELOG.md --- CHANGELOG.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 28d0185e..42007611 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,8 @@ # 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 + 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