{-
Copyright 2016 Awake Networks
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
module Main where
import Control.Arrow ( (&&&), second )
import Control.Monad ( guard, void )
import Control.Monad.Trans.State ( StateT(..) )
import qualified Data.Bits as Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder.Internal as BBI
import Data.Either ( isLeft )
import Data.Maybe ( fromMaybe )
import Data.Int
import Data.List ( group )
import qualified Data.Text.Lazy as T
import qualified Data.Vector as V
import Data.Word ( Word8, Word64 )
import Foreign ( sizeOf )
import Proto3.Wire
import qualified Proto3.Wire.Builder as Builder
import qualified Proto3.Wire.Reverse as Reverse
import qualified Proto3.Wire.Encode as Encode
import qualified Proto3.Wire.Decode as Decode
import qualified Test.DocTest
import Test.QuickCheck ( (===), Arbitrary )
import Test.Tasty
import qualified Test.Tasty.HUnit as HU
import qualified Test.Tasty.QuickCheck as QC
main :: IO ()
main = do
Test.DocTest.doctest
[ "-isrc"
, "-fobject-code"
, "src/Proto3/Wire/Builder.hs"
, "src/Proto3/Wire/Reverse.hs"
, "src/Proto3/Wire/Encode.hs"
, "src/Proto3/Wire/Decode.hs"
]
defaultMain tests
tests :: TestTree
tests = testGroup "Tests" [ roundTripTests
, buildSingleChunk
, buildRBufferSizes
, strictByteString
, lazyByteString
, decodeNonsense
, varIntHeavyTests
, packedLargeTests
]
data StringOrInt64 = TString T.Text | TInt64 Int64
deriving (Show,Eq)
instance QC.Arbitrary StringOrInt64 where
arbitrary = QC.oneof [ TString . T.pack <$> QC.arbitrary, TInt64 <$> QC.arbitrary ]
-- This just stress tests the fancy varint encodings with more randomness.
varIntHeavyTests :: TestTree
varIntHeavyTests = adjustOption (const $ QC.QuickCheckTests 10000) $
roundTrip "varInt uint test"
(Encode.uint64 (fieldNumber 1))
(one Decode.uint64 0 `at` fieldNumber 1)
roundTripTests :: TestTree
roundTripTests = testGroup "Roundtrip tests"
[ roundTrip "int32"
(Encode.int32 (fieldNumber 1))
(one Decode.int32 0 `at` fieldNumber 1)
, roundTrip "int64"
(Encode.int64 (fieldNumber 1))
(one Decode.int64 0 `at` fieldNumber 1)
, roundTrip "sint32"
(Encode.sint32 (fieldNumber 1))
(one Decode.sint32 0 `at` fieldNumber 1)
, roundTrip "sint64"
(Encode.sint64 (fieldNumber 1))
(one Decode.sint64 0 `at` fieldNumber 1)
, roundTrip "uint32"
(Encode.uint32 (fieldNumber 1))
(one Decode.uint32 0 `at` fieldNumber 1)
, roundTrip "uint64"
(Encode.uint64 (fieldNumber 1))
(one Decode.uint64 0 `at` fieldNumber 1)
, roundTrip "fixed32"
(Encode.fixed32 (fieldNumber 1))
(one Decode.fixed32 0 `at` fieldNumber 1)
, roundTrip "fixed64"
(Encode.fixed64 (fieldNumber 1))
(one Decode.fixed64 0 `at` fieldNumber 1)
, roundTrip "sfixed32"
(Encode.sfixed32 (fieldNumber 1))
(one Decode.sfixed32 0 `at` fieldNumber 1)
, roundTrip "sfixed64"
(Encode.sfixed64 (fieldNumber 1))
(one Decode.sfixed64 0 `at` fieldNumber 1)
, roundTrip "float"
(Encode.float (fieldNumber 1))
(one Decode.float 0 `at` fieldNumber 1)
, roundTrip "double"
(Encode.double (fieldNumber 1))
(one Decode.double 0 `at` fieldNumber 1)
, roundTrip "bool"
(Encode.bool (fieldNumber 1))
(one Decode.bool False `at` fieldNumber 1)
, roundTrip "text"
(Encode.text (fieldNumber 1) . T.pack)
(one (fmap T.unpack Decode.text) mempty `at`
fieldNumber 1)
, roundTrip "embedded"
(Encode.embedded (fieldNumber 1) .
Encode.int32 (fieldNumber 1))
(fmap (fromMaybe 0)
(Decode.embedded (one Decode.int32
0 `at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListPackedVarints"
(Encode.embedded (fieldNumber 1) .
Encode.packedVarints (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (one Decode.packedVarints []
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListPackedFixed32"
(Encode.embedded (fieldNumber 1) .
Encode.packedFixed32 (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (one Decode.packedFixed32 []
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListPackedFixed64"
(Encode.embedded (fieldNumber 1) .
Encode.packedFixed64 (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (one Decode.packedFixed64 []
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListPackedFloats"
(Encode.embedded (fieldNumber 1) .
Encode.packedFloats (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (one Decode.packedFloats []
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListPackedDoubles"
(Encode.embedded (fieldNumber 1) .
Encode.packedDoubles (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (one Decode.packedDoubles []
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "embeddedListUnpacked"
(Encode.embedded (fieldNumber 1) .
(foldMap . Encode.int32) (fieldNumber 1))
(fmap (fromMaybe [0,1,2,3,4])
(Decode.embedded (repeated Decode.int32
`at`
fieldNumber 1))
`at` fieldNumber 1)
, roundTrip "multiple fields"
(\(a, b) -> Encode.int32 (fieldNumber 1)
a <>
Encode.uint32 (fieldNumber 2) b)
((,) <$>
one Decode.int32 0 `at`
fieldNumber 1
<*> one Decode.uint32 0 `at`
fieldNumber 2)
, roundTrip "oneof"
(\case Just (TString text) -> Encode.text (fieldNumber 3) text
Just (TInt64 i) -> Encode.int64 (fieldNumber 2) i
Nothing -> mempty
)
(oneof Nothing
[ (fieldNumber 2, Just . TInt64 <$> one Decode.int64 0)
, (fieldNumber 3, Just . TString <$> one Decode.text mempty)
]
)
, roundTrip "oneof-last"
(\case Just (TString text) -> Encode.text (fieldNumber 3) "something" <> Encode.text (fieldNumber 3) text
Just (TInt64 i) -> Encode.int64 (fieldNumber 2) 20000000 <> Encode.int64 (fieldNumber 2) i
Nothing -> mempty
)
(oneof Nothing
[ (fieldNumber 2, Just . TInt64 <$> one Decode.int64 0)
, (fieldNumber 3, Just . TString <$> one Decode.text mempty)
]
)
]
roundTrip :: (Show a, Eq a, Arbitrary a)
=> String
-> (a -> Encode.MessageBuilder)
-> Decode.Parser Decode.RawMessage a
-> TestTree
roundTrip name encode decode =
QC.testProperty name $
\x -> do
let bytes = Encode.toLazyByteString (encode x)
case Decode.parse decode (BL.toStrict bytes) of
Left _ -> error "Could not decode encoded message"
Right x' -> x === x'
buildSingleChunk :: TestTree
buildSingleChunk = HU.testCase "Legacy Builder creates a single chunk" $ do
let chunks = length . BL.toChunks . Builder.toLazyByteString
huge = B.replicate (BBI.maximalCopySize + 16) 1
huge2 = Builder.byteString huge <> Builder.byteString huge
hugeL = BL.fromChunks [huge, huge]
hugeL2 = Builder.lazyByteString hugeL <> Builder.lazyByteString hugeL
HU.assertBool "single chunk (strict)" $ chunks huge2 == 1
HU.assertBool "single chunk (lazy)" $ chunks hugeL2 == 1
parseBytes :: Int64 -> StateT BL.ByteString Maybe BL.ByteString
parseBytes n = StateT $ \bl -> do
let (prefix, suffix) = BL.splitAt n bl
guard (BL.length prefix == n)
pure (prefix, suffix)
-- | Parses a big-endian 64-bit unsigned integer.
parseWord64BE :: StateT BL.ByteString Maybe Word64
parseWord64BE = do
let be n bl = maybe n (j n) (BL.uncons bl)
j n (h, t) = be (256 * n + fromIntegral h) t
be 0 <$> parseBytes 8
-- | Consumes and returns the longest prefix whose bytes
-- all satisfy the given predicate. Never fails.
parseWhile :: (Word8 -> Bool) -> StateT BL.ByteString Maybe BL.ByteString
parseWhile p = StateT (Just . BL.span p)
-- | Run-length encode lazy a 'BL.ByteString'
-- for concise display in test results.
rle :: BL.ByteString -> [(Int, Word8)]
rle = map (length &&& head) . group . BL.unpack
-- | Please adjust this expected size of the metadata header
-- to match that expected of the current implementation.
buildRMeta :: Int
buildRMeta = 2 * sizeOf (undefined :: Word) + sizeOf (undefined :: Double)
buildRSmallChunkSize :: Int
buildRSmallChunkSize = BBI.smallChunkSize - buildRMeta
buildRDefaultChunkSize :: Int
buildRDefaultChunkSize = BBI.defaultChunkSize - buildRMeta
-- | Encodes the given 64-bit unsigned integer in big-endian format.
encodeWord64BE :: Word64 -> B.ByteString
encodeWord64BE = B.pack . go 8
where
go n w
| n <= 0 = []
| otherwise = fromIntegral (Bits.shiftR w (8 * (n - 1))) : go (n - 1) w
-- | Writes the given byte into all the previously-unused
-- bytes in the current buffer.
fillUnused :: Word8 -> Reverse.BuildR
fillUnused = fillUnusedExcept 0
-- | Like 'fillUnused', but writes fewer bytes in order to leave
-- the specified number of bytes unused, unless we start with fewer,
-- in which case there is no change at all.
fillUnusedExcept :: Int -> Word8 -> Reverse.BuildR
fillUnusedExcept unusedRemaining w8 = Reverse.testWithUnused $ \u ->
foldMap (const (Reverse.word8 w8)) [unusedRemaining + 1 .. u]
{-# NOINLINE fillUnusedExcept #-}
-- In case rewrite rules would interfere with buffer boundaries,
-- which may be fine normally, we forbid inlining of this probe.
buildRBufferSizes :: TestTree
buildRBufferSizes = HU.testCase "BuildR buffer sizes" $ do
let builder1 m = Reverse.ensure (max 8 m) $ Reverse.testWithUnused $ \u ->
Reverse.word64BE (fromIntegral u) <> fillUnusedExcept 8 7
{-# NOINLINE builder1 #-}
let builder3 =
builder1 (buildRDefaultChunkSize + 1) <> builder1 0 <> builder1 0
let encodedBytes :: BL.ByteString
encodedBytes = Reverse.toLazyByteString builder3
let parseBuffer :: StateT BL.ByteString Maybe Word64
parseBuffer = do
n <- parseWord64BE
_ <- parseBytes (max 0 (fromIntegral n - 8))
pure n
let parseBuffer3 :: StateT BL.ByteString Maybe (Word64, Word64, Word64)
parseBuffer3 = do
x <- parseBuffer
y <- parseBuffer
z <- parseBuffer
pure (x, y, z)
let actual, expected :: Maybe ((Word64, Word64, Word64), [(Int, Word8)])
actual = second rle <$> runStateT parseBuffer3 encodedBytes
expected = Just ((t, s, f), [])
-- We build in reverse but parser forward; therefore
-- the initial allocation is the final component.
where
t = fromIntegral buildRDefaultChunkSize + 1
s = fromIntegral buildRDefaultChunkSize
f = fromIntegral buildRSmallChunkSize
let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)
HU.assertEqual msg expected actual
strictByteString :: TestTree
strictByteString = HU.testCase "Strict ByteString BuildR" $ do
-- Because the initial buffer has a distinctive size we can use
-- to distinguish it from other buffers, we start with a string
-- that does not fit in that buffer, so that we can check that
-- the buffer is reused as-is after those strings, not reallocated.
let builder1 = Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate (buildRSmallChunkSize + 1) 10 <>
encodeWord64BE (fromIntegral u)
{-# NOINLINE builder1 #-}
-- Then we write strings that do fit within the initial buffer.
let builder2 = Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 20 <> encodeWord64BE (fromIntegral u)
{-# NOINLINE builder2 #-}
let builder3 = Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 30 <> encodeWord64BE (fromIntegral u)
{-# NOINLINE builder3 #-}
-- Then we check the just-enough-room case, which incidentally
-- ensures that we use enough of the initial buffer that it
-- will not be recycled.
let builder4 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 40 <> encodeWord64BE (fromIntegral u) )
<> fillUnusedExcept 11 (0xD0 - 4) <>
( Reverse.testWithUnused $ \u -> Reverse.byteString $
encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder4 #-}
-- Then the case of the almost-full-buffer with not quite enough room.
let builder5 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 50 <> encodeWord64BE (fromIntegral u) )
<> fillUnusedExcept 10 (0xD0 - 5) <>
( Reverse.testWithUnused $ \u -> Reverse.byteString $
encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder5 #-}
-- Then the full-buffer case.
let builder6 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 60 <> encodeWord64BE (fromIntegral u) )
<> fillUnused (0xD0 - 6) <>
( Reverse.testWithUnused $ \u -> Reverse.byteString $
encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder6 #-}
-- Check final unused.
let builder7 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $
B.replicate 3 70 <> encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder7 #-}
let buildAll = builder7 <> builder6 <> builder5 <>
builder4 <> builder3 <> builder2 <> builder1
let encodedBytes :: BL.ByteString
encodedBytes = Reverse.toLazyByteString buildAll
let parseFixed :: Int64 -> Word8 -> StateT BL.ByteString Maybe ()
parseFixed n w = do
bl <- parseBytes n
guard (BL.all (w ==) bl)
let parsePad :: Word8 -> StateT BL.ByteString Maybe ()
parsePad = void . parseWhile . (==)
let parseAll :: StateT BL.ByteString Maybe
( Word64, (Word64, Word64), (Word64, Word64),
(Word64, Word64), Word64, Word64, Word64 )
parseAll = do
parseFixed 3 70
u7 <- parseWord64BE
parseFixed 3 60
u6B <- parseWord64BE
parsePad (0xD0 - 6)
u6A <- parseWord64BE
parseFixed 3 50
u5B <- parseWord64BE
parsePad (0xD0 - 5)
u5A <- parseWord64BE
parseFixed 3 40
u4B <- parseWord64BE
parsePad (0xD0 - 4)
u4A <- parseWord64BE
parseFixed 3 30
u3 <- parseWord64BE
parseFixed 3 20
u2 <- parseWord64BE
parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 10
u1 <- parseWord64BE
pure (u7, (u6B, u6A), (u5B, u5A), (u4B, u4A), u3, u2, u1)
let actual, expected ::
Maybe ( ( Word64, (Word64, Word64), (Word64, Word64)
, (Word64, Word64), Word64, Word64, Word64 )
, [(Int, Word8)]
)
actual = second rle <$> runStateT parseAll encodedBytes
expected = Just ((u7, (u6B,u6A), (u5B,u5A), (u4B, u4A), u3, u2, u1), [])
where
u1 = fromIntegral $ buildRSmallChunkSize -- before we wrote anything
u2 = fromIntegral $ buildRSmallChunkSize -- bypassed unused buffer
u3 = fromIntegral $ buildRSmallChunkSize - 11 -- after second write
u4A = fromIntegral $ buildRSmallChunkSize - 22 -- after third write
u4B = 11 -- after padding
u5A = 0 -- buffer full from previous write
u5B = 10 -- after padding
u6A = fromIntegral $ buildRDefaultChunkSize
-- new buffer after bypassing used buffer
u6B = 0 -- buffer completely full
u7 = fromIntegral $ buildRDefaultChunkSize
-- new buffer after bypassing used buffer
let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)
HU.assertEqual msg expected actual
lazyByteString :: TestTree
lazyByteString = HU.testCase "Strict ByteString BuildR" $ do
-- Because the initial buffer has a distinctive size we can use
-- to distinguish it from other buffers, we start with a string
-- whose chunks do not fit in that buffer, so that we can check that
-- the buffer is reused as-is after those strings, not reallocated.
let builder1 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 12 ) <>
BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 11 ) <>
BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 10 <>
encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder1 #-}
-- Then we write a string whose rightmost two chunks do fit
-- within the initial buffer but whose leftmost chunk does
-- not fit after the others are written. We ensure that most
-- of the initial buffer is consumed because otherwise it might
-- be recycled, which would prevent us from detecting that some
-- chunks were actually written to the buffer.
let builder2 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict ( B.replicate 3 22 ) <>
BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1 - 14) 21 ) <>
BL.fromStrict ( B.replicate 3 20 <> encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder2 #-}
-- And a string that fits entirely within the second buffer.
let builder3 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict ( B.replicate 3 32 ) <>
BL.fromStrict ( B.replicate 3 31 ) <>
BL.fromStrict ( B.replicate 3 30 <> encodeWord64BE (fromIntegral u) )
{-# NOINLINE builder3 #-}
-- Then we check the just-enough-room case.
let builder4 =
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (B.replicate 3 41) <>
BL.fromStrict (B.replicate 3 40 <> encodeWord64BE (fromIntegral u))
) <> fillUnusedExcept 14 (0xD0 - 4) <>
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (encodeWord64BE (fromIntegral u))
)
{-# NOINLINE builder4 #-}
-- Then the case of the almost-full-buffer with not quite enough room.
let builder5 =
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (B.replicate 3 51) <>
BL.fromStrict (B.replicate 3 50 <> encodeWord64BE (fromIntegral u))
) <> fillUnusedExcept 13 (0xD0 - 5) <>
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (encodeWord64BE (fromIntegral u))
)
{-# NOINLINE builder5 #-}
-- Then the full-buffer case.
let builder6 =
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (B.replicate 3 61) <>
BL.fromStrict (B.replicate 3 60 <> encodeWord64BE (fromIntegral u))
) <> fillUnused (0xD0 - 6) <>
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (encodeWord64BE (fromIntegral u))
)
{-# NOINLINE builder6 #-}
-- Check final unused.
let builder7 =
( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $
BL.fromStrict (B.replicate 3 70 <> encodeWord64BE (fromIntegral u))
)
{-# NOINLINE builder7 #-}
let buildAll = builder7 <> builder6 <> builder5 <>
builder4 <> builder3 <> builder2 <> builder1
let encodedBytes :: BL.ByteString
encodedBytes = Reverse.toLazyByteString buildAll
let parseFixed :: Int64 -> Word8 -> StateT BL.ByteString Maybe ()
parseFixed n w = do
bl <- parseBytes n
guard (BL.all (w ==) bl)
let parsePad :: Word8 -> StateT BL.ByteString Maybe ()
parsePad = void . parseWhile . (==)
let parseAll :: StateT BL.ByteString Maybe
( Word64, (Word64, Word64), (Word64, Word64),
(Word64, Word64), Word64, Word64, Word64 )
parseAll = do
parseFixed 3 70
u7 <- parseWord64BE
parseFixed 3 61
parseFixed 3 60
u6B <- parseWord64BE
parsePad (0xD0 - 6)
u6A <- parseWord64BE
parseFixed 3 51
parseFixed 3 50
u5B <- parseWord64BE
parsePad (0xD0 - 5)
u5A <- parseWord64BE
parseFixed 3 41
parseFixed 3 40
u4B <- parseWord64BE
parsePad (0xD0 - 4)
u4A <- parseWord64BE
parseFixed 3 32
parseFixed 3 31
parseFixed 3 30
u3 <- parseWord64BE
parseFixed 3 22
parseFixed (fromIntegral (buildRSmallChunkSize + 1 - 14)) 21
parseFixed 3 20
u2 <- parseWord64BE
parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 12
parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 11
parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 10
u1 <- parseWord64BE
pure (u7, (u6B, u6A), (u5B, u5A), (u4B, u4A), u3, u2, u1)
let actual, expected ::
Maybe ( ( Word64, (Word64, Word64), (Word64, Word64)
, (Word64, Word64), Word64, Word64, Word64 )
, [(Int, Word8)]
)
actual = second rle <$> runStateT parseAll encodedBytes
expected = Just ((u7, (u6B,u6A), (u5B,u5A), (u4B, u4A), u3, u2, u1), [])
where
u1 = fromIntegral $ buildRSmallChunkSize -- before we wrote anything
u2 = fromIntegral $ buildRSmallChunkSize -- bypassed unused buffer
u3 = fromIntegral $ buildRDefaultChunkSize -- after second write
u4A = fromIntegral $ buildRDefaultChunkSize - 17 -- after third write
u4B = 14 -- after padding
u5A = 0 -- buffer full from previous write
u5B = 13 -- after padding
u6A = fromIntegral $ buildRDefaultChunkSize
-- new buffer after bypassing used buffer
u6B = 0 -- buffer completely full
u7 = fromIntegral $ buildRDefaultChunkSize
-- new buffer after bypassing used buffer
let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)
HU.assertEqual msg expected actual
decodeNonsense :: TestTree
decodeNonsense = HU.testCase "Decoding a nonsensical string fails." $ do
let decoded = Decode.parse (one Decode.fixed64 0 `at` fieldNumber 1) "test"
HU.assertBool "decode fails" $ isLeft decoded
packedLargeTests :: TestTree
packedLargeTests = testGroup "Test packed encoders on large inputs"
[ packedVarints_large
, packedVarintsV_large
, packedBoolsV_large
, packedFixed32_large
, packedFixed32V_large
, packedFixed64_large
, packedFixed64V_large
, packedFloats_large
, packedFloatsV_large
, packedDoubles_large
, packedDoublesV_large
]
packedVarints_large :: TestTree
packedVarints_large = HU.testCase "Large packedVarints" $ do
let count = 40000
encoded = Encode.toLazyByteString (Encode.packedVarints 13 [1 .. count])
decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [1 .. count]) decoded
packedVarintsV_large :: TestTree
packedVarintsV_large = HU.testCase "Large packedVarintsV" $ do
let count = 40000
encoded = Encode.toLazyByteString
(Encode.packedVarintsV (1 +) 13 (V.fromList [1 .. count]))
decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded
packedBoolsV_large :: TestTree
packedBoolsV_large = HU.testCase "Large packedBoolsV" $ do
let count = 40000 :: Int
values = map (flip Bits.testBit 0) [1 .. count]
encoded = Encode.toLazyByteString
(Encode.packedBoolsV not 13 (V.fromList values))
decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right (map (fromEnum . not) values)) decoded
packedFixed32_large :: TestTree
packedFixed32_large = HU.testCase "Large packedFixed32" $ do
let count = 40000
encoded = Encode.toLazyByteString (Encode.packedFixed32 13 [1 .. count])
decoded = Decode.parse (one Decode.packedFixed32 [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [1 .. count]) decoded
packedFixed32V_large :: TestTree
packedFixed32V_large = HU.testCase "Large packedFixed32V" $ do
let count = 40000
encoded = Encode.toLazyByteString
(Encode.packedFixed32V (1 +) 13 (V.fromList [1 .. count]))
decoded = Decode.parse (one Decode.packedFixed32 [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded
packedFixed64_large :: TestTree
packedFixed64_large = HU.testCase "Large packedFixed64" $ do
let count = 40000
encoded = Encode.toLazyByteString (Encode.packedFixed64 13 [1 .. count])
decoded = Decode.parse (one Decode.packedFixed64 [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [1 .. count]) decoded
packedFixed64V_large :: TestTree
packedFixed64V_large = HU.testCase "Large packedFixed64V" $ do
let count = 40000
encoded = Encode.toLazyByteString
(Encode.packedFixed64V (1 +) 13 (V.fromList [1 .. count]))
decoded = Decode.parse (one Decode.packedFixed64 [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded
packedFloats_large :: TestTree
packedFloats_large = HU.testCase "Large packedFloats" $ do
let count = 40000
encoded = Encode.toLazyByteString (Encode.packedFloats 13 [1 .. count])
decoded = Decode.parse (one Decode.packedFloats [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [1 .. count]) decoded
packedFloatsV_large :: TestTree
packedFloatsV_large = HU.testCase "Large packedFloatsV" $ do
let count = 40000
encoded = Encode.toLazyByteString
(Encode.packedFloatsV (1 +) 13 (V.fromList [1 .. count]))
decoded = Decode.parse (one Decode.packedFloats [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded
packedDoubles_large :: TestTree
packedDoubles_large = HU.testCase "Large packedDoubles" $ do
let count = 40000
encoded = Encode.toLazyByteString (Encode.packedDoubles 13 [1 .. count])
decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [1 .. count]) decoded
packedDoublesV_large :: TestTree
packedDoublesV_large = HU.testCase "Large packedDoublesV" $ do
let count = 40000
encoded = Encode.toLazyByteString
(Encode.packedDoublesV (1 +) 13 (V.fromList [1 .. count]))
decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded