diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for cborg +## 0.2.9.0 + +* Fix build with `base >= 4.17` on platforms without unaligned memory operations. +* Fix `Eq`, `Ord`, `Show` and `IsList` instances for `SlicedByteArray` when offset is present +* Fix `toBuilder` and `encodeByteArray` for `SlicedByteArray` when offset is present + ## 0.2.8.0 -- 2022-09-24 * Support GHC 9.4 diff --git a/cborg.cabal b/cborg.cabal --- a/cborg.cabal +++ b/cborg.cabal @@ -1,5 +1,5 @@ name: cborg -version: 0.2.8.0 +version: 0.2.9.0 synopsis: Concise Binary Object Representation (CBOR) license: BSD3 license-file: LICENSE.txt @@ -19,7 +19,8 @@ GHC == 8.10.7, GHC == 9.0.1, GHC == 9.2.2, - GHC == 9.4.2 + GHC == 9.4.2, + GHC == 9.6.1 extra-source-files: ChangeLog.md @@ -89,13 +90,13 @@ build-depends: array >= 0.4 && < 0.6, - base >= 4.11 && < 4.18, + base >= 4.11 && < 4.19, bytestring >= 0.10.4 && < 0.12, containers >= 0.5 && < 0.7, deepseq >= 1.0 && < 1.5, - ghc-prim >= 0.3.1.0 && < 0.10, + ghc-prim >= 0.3.1.0 && < 0.11, half >= 0.2.2.3 && < 0.4, - primitive >= 0.5 && < 0.8, + primitive >= 0.5 && < 0.9, text >= 1.1 && < 1.3 || >= 2.0 && <2.1 if flag(optimize-gmp) @@ -147,10 +148,11 @@ build-depends: array >= 0.4 && < 0.6, - base >= 4.11 && < 4.18, + base >= 4.11 && < 4.19, base-orphans, bytestring >= 0.10.4 && < 0.12, text >= 1.1 && < 2.1, + primitive >= 0.5 && < 0.9, cborg, aeson >= 0.7 && < 2.2, base64-bytestring >= 1.0 && < 1.3, @@ -163,7 +165,7 @@ tasty >= 0.11 && < 1.5, tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.11, - vector >= 0.10 && < 0.13 + vector >= 0.10 && < 0.14 if !impl(ghc >= 8.0) build-depends: fail >= 4.9.0.0 && < 4.10 diff --git a/src/Codec/CBOR/ByteArray/Internal.hs b/src/Codec/CBOR/ByteArray/Internal.hs --- a/src/Codec/CBOR/ByteArray/Internal.hs +++ b/src/Codec/CBOR/ByteArray/Internal.hs @@ -41,9 +41,10 @@ -> a foldrByteArray f z off0 len ba = go off0 where + len' = len + off0 go !off - | off == len = z - | otherwise = + | off >= len' = z + | otherwise = let x = Prim.indexByteArray ba off in f x (go (off+1)) diff --git a/src/Codec/CBOR/ByteArray/Sliced.hs b/src/Codec/CBOR/ByteArray/Sliced.hs --- a/src/Codec/CBOR/ByteArray/Sliced.hs +++ b/src/Codec/CBOR/ByteArray/Sliced.hs @@ -84,7 +84,7 @@ Prim.unsafeFreezeByteArray ba' toBuilder :: SlicedByteArray -> BSB.Builder -toBuilder = \(SBA ba off len) -> BSB.builder (go ba off len) +toBuilder = \(SBA ba off len) -> BSB.builder (go ba off (len + off)) where go ba !ip !ipe !k (BSB.BufferRange op ope) | inpRemaining <= outRemaining = do @@ -133,9 +133,10 @@ | otherwise = let (!) :: Prim.ByteArray -> Int -> Word8 (!) = Prim.indexByteArray + -- len1 and len2 are known to be equal at this point + len1' = len1 + off1 go i1 i2 - | i1 == len1 && i2 == len2 = True - | i1 == len1 || i2 == len2 = False + | i1 == len1' = True | (arr1 ! i1) == (arr2 ! i2) = go (i1+1) (i2+1) | otherwise = False in go off1 off2 @@ -150,10 +151,12 @@ | otherwise = let (!) :: Prim.ByteArray -> Int -> Word8 (!) = Prim.indexByteArray + len1' = len1 + off1 + len2' = len2 + off2 go i1 i2 - | i1 == len1 && i2 == len2 = EQ - | i1 == len1 || i2 == len2 = len1 `compare` len2 - | EQ <- o = go (i1+1) (i2+1) - | otherwise = o + | i1 == len1' && i2 == len2' = EQ + | i1 == len1' || i2 == len2' = len1 `compare` len2 + | EQ <- o = go (i1+1) (i2+1) + | otherwise = o where o = (arr1 ! i1) `compare` (arr2 ! i2) in go off1 off2 diff --git a/src/Codec/CBOR/Magic.hs b/src/Codec/CBOR/Magic.hs --- a/src/Codec/CBOR/Magic.hs +++ b/src/Codec/CBOR/Magic.hs @@ -257,11 +257,15 @@ #endif #if WORD_SIZE_IN_BITS == 64 +#if MIN_VERSION_base(4,17,0) +-- case taken from Codec.CBOR.Decoding + w64 w# = W64# (wordToWord64# (toWord w#)) +#else w64 w# = W64# (toWord w#) +#endif #else w64 w# = W64# (wordToWord64# (toWord w#)) #endif - #endif -------------------------------------------------------------------------------- diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -38,6 +38,7 @@ import Prelude hiding (decodeFloat, encodeFloat) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Word import Data.Int @@ -47,6 +48,9 @@ import Data.Proxy import Data.Kind (Type) +import GHC.Exts +import Codec.CBOR.ByteArray +import qualified Codec.CBOR.ByteArray.Sliced as Sliced import Codec.CBOR.Term import Codec.CBOR.Read import Codec.CBOR.Write @@ -56,10 +60,10 @@ import Test.Tasty (TestTree, testGroup, localOption) import Test.Tasty.QuickCheck (testProperty, QuickCheckMaxSize(..)) import Test.QuickCheck -import System.Random (Random) +import Test.QuickCheck.Gen (Gen (MkGen)) import qualified Tests.Reference.Implementation as Ref -import Tests.Reference.Implementation (UInt(..)) +import Tests.Reference.Implementation (UInt(..), lengthUInt) import Tests.Reference.Generators import Tests.Term ( fromRefTerm, toRefTerm, eqTerm, canonicaliseTerm ) @@ -70,6 +74,15 @@ #endif +#if MIN_VERSION_bytestring(0,11,1) +import qualified Data.ByteString.Short as SBS +#else +import qualified Data.ByteString.Short.Internal as SBS +#endif + +import qualified Data.Primitive.ByteArray as Prim (ByteArray (..)) +import System.Random.Stateful hiding (genByteString, genShortByteString) + -- | The CBOR implementation and its reference implementation satisfy all the -- properties implied in the following commuting diagram. -- @@ -984,7 +997,53 @@ encodeRef = Ref.encodeTerm decodeRef _ = Ref.decodeTerm +-------------------------------------------------------------------------------- +-- Token class instances for ByteArray tokens. +-- +newtype TokByteArray = TokByteArray { unTokByteArray :: [Word8] } + deriving (Eq, Show) + +instance Arbitrary TokByteArray where + arbitrary = TokByteArray <$> arbitrary + +instance Token TokByteArray where + type Imp TokByteArray = Sliced.SlicedByteArray + + eqImp _ = (==) + + fromRef = Sliced.fromByteString . BS.pack . unTokByteArray + toRef _ = TokByteArray . toList + + canonicaliseImp _ = id + canonicaliseRef = id + + encodeImp _ = encodeByteArray + decodeImp _ = toSliced <$> decodeByteArray + + encodeRef (TokByteArray bs) = Ref.encodeToken (Ref.MT2_ByteString (lengthUInt bs) bs) + decodeRef _ = do Ref.MT2_ByteString _n bs <- Ref.decodeToken + -- TODO? check _n == bs + return (TokByteArray bs) + +instance Arbitrary Sliced.SlicedByteArray where + -- Taken from cardano-ledger-binary testlib. + arbitrary = do + NonNegative off <- arbitrary + Positive count <- arbitrary + NonNegative slack <- arbitrary + let len = off + count + slack + ba <- genByteArray len + pure $ Sliced.SBA ba off count + + where + genShortByteString :: Int -> Gen SBS.ShortByteString + genShortByteString n = MkGen (\r _n -> runStateGen_ r (uniformShortByteString n)) + + genByteArray :: Int -> Gen Prim.ByteArray + genByteArray n = do + SBS.SBS ba <- genShortByteString n + pure (Prim.ByteArray ba) -------------------------------------------------------------------------------- -- TestTree API @@ -1011,6 +1070,7 @@ , testProperty "Tag64" (prop_fromRefToRef (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_fromRefToRef (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_fromRefToRef (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_fromRefToRef (Proxy :: Proxy TokByteArray)) ] , testGroup "from . id . to = canon_imp" @@ -1033,6 +1093,7 @@ , testProperty "Tag64" (prop_toRefFromRef (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_toRefFromRef (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_toRefFromRef (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_toRefFromRef (Proxy :: Proxy TokByteArray)) ] , testGroup "dec_ref . enc_ref = id" @@ -1055,6 +1116,7 @@ , testProperty "Tag64" (prop_encodeRefdecodeRef (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_encodeRefdecodeRef (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_encodeRefdecodeRef (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeRefdecodeRef (Proxy :: Proxy TokByteArray)) ] , testGroup "dec_imp . enc_imp = canon_imp" @@ -1077,6 +1139,7 @@ , testProperty "Tag64" (prop_encodeImpdecodeImp (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_encodeImpdecodeImp (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_encodeImpdecodeImp (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeImpdecodeImp (Proxy :: Proxy TokByteArray)) ] , testGroup "dec_imp . enc_imp = canon_imp (all 2-splits)" @@ -1100,6 +1163,7 @@ , testProperty "Simple" (prop_encodeImpdecodeImp_splits2 (Proxy :: Proxy Ref.Simple)) , localOption (QuickCheckMaxSize 100) $ testProperty "Term" (prop_encodeImpdecodeImp_splits2 (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeImpdecodeImp_splits2 (Proxy :: Proxy TokByteArray)) ] , testGroup "dec_imp . enc_imp = canon_imp (all 3-splits)" @@ -1123,6 +1187,7 @@ , testProperty "Simple" (prop_encodeImpdecodeImp_splits3 (Proxy :: Proxy Ref.Simple)) , localOption (QuickCheckMaxSize 25) $ testProperty "Term" (prop_encodeImpdecodeImp_splits3 (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeImpdecodeImp_splits3 (Proxy :: Proxy TokByteArray)) ] , testGroup "enc_imp . from = enc_ref . canon_ref" @@ -1145,6 +1210,7 @@ , testProperty "Tag64" (prop_encodeRefencodeImp1 (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_encodeRefencodeImp1 (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_encodeRefencodeImp1 (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeRefencodeImp1 (Proxy :: Proxy TokByteArray)) ] , testGroup "enc_ref . to = enc_imp" @@ -1167,6 +1233,7 @@ , testProperty "Tag64" (prop_encodeRefencodeImp2 (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_encodeRefencodeImp2 (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_encodeRefencodeImp2 (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_encodeRefencodeImp2 (Proxy :: Proxy TokByteArray)) ] , testGroup "dec_imp . enc_ref = from . dec_ref . enc_ref" @@ -1189,5 +1256,6 @@ , testProperty "Tag64" (prop_decodeRefdecodeImp (Proxy :: Proxy TokTag64)) , testProperty "Simple" (prop_decodeRefdecodeImp (Proxy :: Proxy Ref.Simple)) , testProperty "Term" (prop_decodeRefdecodeImp (Proxy :: Proxy Ref.Term)) + , testProperty "ByteArray" (prop_decodeRefdecodeImp (Proxy :: Proxy TokByteArray)) ] ] diff --git a/tests/Tests/Reference/Implementation.hs b/tests/Tests/Reference/Implementation.hs --- a/tests/Tests/Reference/Implementation.hs +++ b/tests/Tests/Reference/Implementation.hs @@ -27,6 +27,7 @@ fromUInt, toUInt, canonicaliseUInt, + lengthUInt, Simple(..), fromSimple,