diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for borsh +## 0.2.0 -- 2022-11-15 + +* Remove dependency on `memory` +* Don't newtype-wrap `Int128` and `Word128` +* Improve documentation of the incremental interface +* Make size argument to `FixedSizeArray` nominal + ## 0.1.0 -- 2022-11-11 * First released version diff --git a/borsh.cabal b/borsh.cabal --- a/borsh.cabal +++ b/borsh.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: borsh -version: 0.1.0 +version: 0.2.0 synopsis: Implementation of BORSH serialisation description: This package provides type classes and combinators for @@ -23,6 +23,13 @@ extra-doc-files: CHANGELOG.md bug-reports: https://github.com/well-typed/borsh/issues +tested-with: + GHC == 8.6.5 + , GHC == 8.8.3 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.2 + source-repository head type: git location: https://github.com/well-typed/borsh @@ -75,8 +82,6 @@ Codec.Borsh.Incremental Data.FixedSizeArray - Data.Int128 - Data.Word128 other-modules: Codec.Borsh.Class Codec.Borsh.Decoding @@ -94,7 +99,6 @@ , bytestring >= 0.10 && < 0.12 , containers >= 0.6 && < 0.7 , generics-sop >= 0.5 && < 0.6 - , memory >= 0.17 && < 0.19.0 , sop-core >= 0.5 && < 0.6 , text >= 1.2 && < 2.1 @@ -136,3 +140,4 @@ , tasty , tasty-quickcheck , text + , wide-word diff --git a/src/Codec/Borsh/Class.hs b/src/Codec/Borsh/Class.hs --- a/src/Codec/Borsh/Class.hs +++ b/src/Codec/Borsh/Class.hs @@ -23,6 +23,8 @@ import Data.Proxy import Data.Set (Set) import Data.Text (Text) +import Data.WideWord.Int128 +import Data.WideWord.Word128 import Data.Word import Generics.SOP import GHC.TypeNats @@ -35,8 +37,6 @@ import Codec.Borsh.Encoding import Codec.Borsh.Incremental import Data.FixedSizeArray (FixedSizeArray) -import Data.Int128 -import Data.Word128 (Word128) {------------------------------------------------------------------------------- Size information diff --git a/src/Codec/Borsh/Decoding.hs b/src/Codec/Borsh/Decoding.hs --- a/src/Codec/Borsh/Decoding.hs +++ b/src/Codec/Borsh/Decoding.hs @@ -36,6 +36,8 @@ import Data.Set (Set) import Data.STRef import Data.Text (Text) +import Data.WideWord.Word128 +import Data.WideWord.Int128 import Data.Word import Generics.SOP import GHC.TypeLits @@ -49,11 +51,10 @@ import qualified Data.Vector.Generic.Mutable as GM import Codec.Borsh.Incremental +import Codec.Borsh.Incremental.Decoder (decodeLittleEndian) import Codec.Borsh.Internal.Util.BitwiseCast import Codec.Borsh.Internal.Util.SOP import Data.FixedSizeArray (FixedSizeArray, MFixedSizeArray) -import Data.Word128 (Word128) -import Data.Int128 (Int128) import qualified Data.FixedSizeArray as FSA diff --git a/src/Codec/Borsh/Encoding.hs b/src/Codec/Borsh/Encoding.hs --- a/src/Codec/Borsh/Encoding.hs +++ b/src/Codec/Borsh/Encoding.hs @@ -39,6 +39,8 @@ import Data.Set (Set) import Data.SOP import Data.Text (Text) +import Data.WideWord.Word128 +import Data.WideWord.Int128 import Data.Word import qualified Data.ByteString as S @@ -51,8 +53,6 @@ import Data.FixedSizeArray (FixedSizeArray) import Codec.Borsh.Internal.Util.ByteString import Codec.Borsh.Internal.Util.SOP (indices) -import Data.Word128 -import Data.Int128 {------------------------------------------------------------------------------- Encoder definition @@ -99,11 +99,11 @@ encodeU128 :: Encoder Word128 encodeU128 = Encoder $ - \w128 -> B.word64LE (word128LS64 w128) <> B.word64LE (word128MS64 w128) + \w128 -> B.word64LE (word128Lo64 w128) <> B.word64LE (word128Hi64 w128) encodeI128 :: Encoder Int128 encodeI128 = Encoder $ - \i128 -> B.word64LE (int128LS64 i128) <> B.word64LE (int128MS64 i128) + \i128 -> B.word64LE (int128Lo64 i128) <> B.word64LE (int128Hi64 i128) -- Encoding 'Text' -- diff --git a/src/Codec/Borsh/Incremental.hs b/src/Codec/Borsh/Incremental.hs --- a/src/Codec/Borsh/Incremental.hs +++ b/src/Codec/Borsh/Incremental.hs @@ -1,27 +1,18 @@ - +-- | Interface for incremental decoding module Codec.Borsh.Incremental ( - -- * Constructing decoders - Decoder(..) - , DecodeResult(..) + -- * Definition + Decoder -- Opaque , liftDecoder + -- * Running decoders , DeserialiseFailure(..) , deserialiseByteString - -- * Specialised decoders - -- - -- | These functions comprise a low-level decoder interface which will not - -- be necessary for most applications. Most applications should simply use - -- 'Codec.Borsh.Class.deserialiseBorsh' - , decodeLittleEndian + + -- * Large tokens , decodeLargeToken , decodeIncremental , decodeIncremental_ - -- * Located values - , Located(..) - , ByteOffset - , LocatedChunk ) where import Codec.Borsh.Incremental.Decoder -import Codec.Borsh.Incremental.Located import Codec.Borsh.Incremental.Monad diff --git a/src/Codec/Borsh/Incremental/Decoder.hs b/src/Codec/Borsh/Incremental/Decoder.hs --- a/src/Codec/Borsh/Incremental/Decoder.hs +++ b/src/Codec/Borsh/Incremental/Decoder.hs @@ -35,6 +35,8 @@ -- | Decoder -- -- A decoder describes how to match against a single chunk of the input. +-- +-- For decoders for primitive types, use 'Codec.Borsh.FromBorsh' instances. newtype Decoder s a = Decoder { matchChunk :: LocatedChunk -> ST s (LocatedChunk, DecodeResult s a) } @@ -43,9 +45,12 @@ Operations supported by the 'Decoder' monad -------------------------------------------------------------------------------} +-- | Lift an 'ST' operation into the 'Decoder' monad. liftDecoder :: ST s a -> Decoder s a liftDecoder sa = Decoder $ \chunk -> (chunk, ) . DecodeDone <$> sa +-- | Decode a value encoded in little endian byte order (e.g. as mandated by the +-- [Borsh](https://borsh.io) spec). decodeLittleEndian :: forall s a. ByteSwap a => Decoder s a decodeLittleEndian = Decoder aux where @@ -57,15 +62,43 @@ Nothing -> return (chunk, DecodeNeedsData decodeLittleEndian) -decodeLargeToken :: Word32 -> Decoder s L.ByteString +-- | Large token of known length that spans multiple chunks +-- +-- This is NOT incremental: all chunks will be read into memory before the +-- result is returned. Primarily useful for large types that are not +-- easily split into (valid) chunks, such as UTF8-encoded text (if were +-- wanted to split that, we'd have to split it at UTF8 boundaries). +decodeLargeToken :: + Word32 -- ^ Number of bytes to decode + -> Decoder s L.ByteString decodeLargeToken n = Decoder $ \chunk -> return (chunk, DecodeLargeToken n return) -decodeIncremental :: Word32 -> Decoder s a -> Decoder s [a] +-- | Incremental interface +-- +-- When decoding large objects such as lists, we do not want to bring all +-- required chunks into memory before decoding the list. Instead, we want to +-- decode the list elements as we go. In this case, 'DecodeIncremental' can +-- be used to repeatedly decode a value using decoder for the elements. +-- +-- NOTE: This interface is incremental in the sense that the /input chunks/ +-- are read one at a time. It is /NOT/ incremental in the generated /output/. +decodeIncremental :: + Word32 -- ^ Number of elements in the sequence to decode + -> Decoder s a -- ^ 'Decoder' to run for the individual elements + -> Decoder s [a] decodeIncremental n d = Decoder $ \chunk -> return (chunk, DecodeIncremental n d return) -decodeIncremental_ :: Word32 -> Decoder s () -> Decoder s () +-- | Variation on 'decoreIncremental', where we do not accumulate results +-- +-- This is useful for example for datatypes that we can update imperatively +-- (using the 'ST' monad), such as mutable arrays. It could also be used to skip +-- over unused parts of the input. +decodeIncremental_ :: + Word32 -- ^ Number of elements in the sequence to decode + -> Decoder s () -- ^ 'Decoder' to run for the individual elements + -> Decoder s () decodeIncremental_ n d = Decoder $ \chunk -> return (chunk, DecodeIncremental_ n d $ return ()) @@ -90,10 +123,7 @@ -- | Large token of known length that spans multiple chunks -- - -- This is NOT incremental: all chunks will be read into memory before the - -- function is applied. Primarily useful for large types that are not - -- easily split into (valid) chunks, such as UTF8-encoded text (if were - -- wanted to split that, we'd have to split it at UTF8 boundaries). + -- See 'decodeLargeToken' for discussion. -- -- The continuation will be called with a lazy bytestring of precisely the -- requested length (provided enough input is available, of course), along @@ -105,14 +135,7 @@ -- | Incremental interface -- - -- When decoding large objects such as lists, we do not want to bring all - -- required chunks into memory before decoding the list. Instead, we want to - -- decode the list elements as we go. In this case, 'DecodeIncremental' can - -- be used to repeatedly decode a value using decoder for the elements; when - -- all elements have been processed, the continuation decoder is called. - -- - -- NOTE: This interface is incremental in the sense that the /input chunks/ - -- are read one at a time. It is /NOT/ incremental in the generated /output/. + -- See 'decodeIncremental' for discussion. DecodeIncremental :: Word32 -- ^ How often to repeat the smaller decoder -> Decoder s a -- ^ Decoder to repeat @@ -121,9 +144,7 @@ -- | Variation on 'DecodeIncremental', where we do not accumulate results -- - -- This is useful for example for datatypes that we can update imperatively, - -- such as mutable arrays. It could also be used to skip over unused parts - -- of the input. + -- See 'decodeIncremental_' for discussion. DecodeIncremental_ :: Word32 -- ^ How often to repeat the smaller decoder -> Decoder s () -- ^ Decoder to repeat (imperatively handling each element) @@ -256,8 +277,13 @@ Top-level API -------------------------------------------------------------------------------} +-- | Run decoder deserialiseByteString :: (forall s. Decoder s a) + -- ^ Decoder -> L.ByteString + -- ^ Input -> Either DeserialiseFailure (L.ByteString, ByteOffset, a) + -- ^ Left-over input, offset of the left-over input relative to the start, + -- and the result. deserialiseByteString d = runIDecode (runIncr (runDecoder d)) diff --git a/src/Codec/Borsh/Internal/Util/BitwiseCast.hs b/src/Codec/Borsh/Internal/Util/BitwiseCast.hs --- a/src/Codec/Borsh/Internal/Util/BitwiseCast.hs +++ b/src/Codec/Borsh/Internal/Util/BitwiseCast.hs @@ -1,11 +1,11 @@ module Codec.Borsh.Internal.Util.BitwiseCast (BitwiseCast(..)) where import Data.Int +import Data.WideWord.Int128 +import Data.WideWord.Word128 import Data.Word import GHC.Float -import Data.Int128 (Int128) -import Data.Word128 (Word128) class BitwiseCast a b where -- | Bit-for-bit copy from @a@ to @b@ diff --git a/src/Codec/Borsh/Internal/Util/ByteSwap.hs b/src/Codec/Borsh/Internal/Util/ByteSwap.hs --- a/src/Codec/Borsh/Internal/Util/ByteSwap.hs +++ b/src/Codec/Borsh/Internal/Util/ByteSwap.hs @@ -5,47 +5,30 @@ -- be necessary anymore. module Codec.Borsh.Internal.Util.ByteSwap ( ByteSwap(..) - , LE(..) - , toLE + , LE (..) , fromLE - , BE(..) - , toBE - , fromBE ) where +import Data.WideWord.Int128 +import Data.WideWord.Word128 import Data.Word import Foreign (Storable) - -import Data.Memory.Endian (getSystemEndianness, Endianness(LittleEndian)) +import GHC.ByteOrder (targetByteOrder, ByteOrder (..)) -- | Little Endian value newtype LE a = LE { unLE :: a } deriving newtype (Show, Eq, Storable) --- | Big Endian value -newtype BE a = BE { unBE :: a } - deriving newtype (Show, Eq, Storable) - --- | Convert a value in cpu endianess to big endian -toBE :: ByteSwap a => a -> BE a -toBE = BE . (if getSystemEndianness == LittleEndian then byteSwap else id) - --- | Convert from a big endian value to the cpu endianness -fromBE :: ByteSwap a => BE a -> a -fromBE (BE a) = if getSystemEndianness == LittleEndian then byteSwap a else a - --- | Convert a value in cpu endianess to little endian -toLE :: ByteSwap a => a -> LE a -toLE = LE . (if getSystemEndianness == LittleEndian then id else byteSwap) - -- | Convert from a little endian value to the cpu endianness fromLE :: ByteSwap a => LE a -> a -fromLE (LE a) = if getSystemEndianness == LittleEndian then a else byteSwap a +fromLE (LE a) = if targetByteOrder == LittleEndian then a else byteSwap a class Storable a => ByteSwap a where byteSwap :: a -> a -instance ByteSwap Word8 where byteSwap = id -instance ByteSwap Word16 where byteSwap = byteSwap16 -instance ByteSwap Word32 where byteSwap = byteSwap32 -instance ByteSwap Word64 where byteSwap = byteSwap64 +instance ByteSwap Word8 where byteSwap = id +instance ByteSwap Word16 where byteSwap = byteSwap16 +instance ByteSwap Word32 where byteSwap = byteSwap32 +instance ByteSwap Word64 where byteSwap = byteSwap64 +instance ByteSwap Word128 where byteSwap = byteSwapWord128 +instance ByteSwap Int128 where byteSwap = byteSwapInt128 diff --git a/src/Data/FixedSizeArray.hs b/src/Data/FixedSizeArray.hs --- a/src/Data/FixedSizeArray.hs +++ b/src/Data/FixedSizeArray.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RoleAnnotations #-} -- | Fixed size arrays -- -- Intended for qualified import @@ -35,6 +36,7 @@ -- -- NOTE: For convenience, this is an instance of 'G.Vector', but the invariant -- that the length of the vector should never change is not currently checked. +type role FixedSizeArray nominal _ newtype FixedSizeArray (n :: Nat) (a :: Type) = FromArray { toArray :: Vector a } diff --git a/src/Data/Int128.hs b/src/Data/Int128.hs deleted file mode 100644 --- a/src/Data/Int128.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module Data.Int128 ( - -- * Definition - Int128 -- Opaque - -- * Construction - , int128 - -- * Destruction - , int128MS64 - , int128LS64 - ) where - -import Data.Bits -import Data.Data -import Data.Ix -import Data.Word -import Foreign -import GHC.Generics - -import qualified Data.WideWord.Int128 as WW - -import Codec.Borsh.Internal.Util.ByteSwap (ByteSwap(..)) - -{------------------------------------------------------------------------------- - Definition, construction, destruction --------------------------------------------------------------------------------} - --- | Signed 128-bit word --- --- Implementation note: this currently relies on the implementation of the --- [wide-word](https://hackage.haskell.org/package/wide-word) package, with some --- additional instances. However, the use of @wide-word@ is not part of the --- public API of the @borsh@ package. -newtype Int128 = Int128 WW.Int128 - deriving stock Data - deriving newtype ( - Bits - , Bounded - , Enum - , Eq - , FiniteBits - , Generic - , Integral - , Ix - , Num - , Ord - , Read - , Real - , Show - , Storable - ) - --- | Construct an 'Int128' -int128 :: - Word64 -- ^ Most significant bits - -> Word64 -- ^ Least significant bits - -> Int128 -int128 hi lo = Int128 (WW.Int128 hi lo) - --- | Get the most significant 64 bits from an 'Int128' -int128MS64 :: Int128 -> Word64 -int128MS64 (Int128 (WW.Int128 hi _)) = hi - --- | Get the least significant 64 bits from an 'Int128' -int128LS64 :: Int128 -> Word64 -int128LS64 (Int128 (WW.Int128 _ lo)) = lo - -{------------------------------------------------------------------------------- - Instances --------------------------------------------------------------------------------} - -instance ByteSwap Int128 where - byteSwap (Int128 (WW.Int128 hi lo)) = - Int128 $ WW.Int128 (byteSwap64 lo) (byteSwap64 hi) diff --git a/src/Data/Word128.hs b/src/Data/Word128.hs deleted file mode 100644 --- a/src/Data/Word128.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module Data.Word128 ( - -- * Definition - Word128 -- opaque - -- * Construction - , word128 - -- * Destruction - , word128MS64 - , word128LS64 - ) where - -import Data.Bits -import Data.Data -import Data.Ix -import Data.Word -import Foreign -import GHC.Generics - -import qualified Data.WideWord.Word128 as WW - -import Codec.Borsh.Internal.Util.ByteSwap (ByteSwap(..)) - -{------------------------------------------------------------------------------- - Definition, construction, destruction --------------------------------------------------------------------------------} - --- | Unsigned 128-bit word --- --- Implementation note: this currently relies on the implementation of the --- [wide-word](https://hackage.haskell.org/package/wide-word) package, with some --- additional instances. However, the use of @wide-word@ is not part of the --- public API of the @borsh@ package. -newtype Word128 = Word128 WW.Word128 - deriving stock Data - deriving newtype ( - Bits - , Bounded - , Enum - , Eq - , FiniteBits - , Generic - , Integral - , Ix - , Num - , Ord - , Read - , Real - , Show - , Storable - ) - --- | Construct a 'Word128' -word128 :: - Word64 -- ^ Most significant bits - -> Word64 -- ^ Least significant bits - -> Word128 -word128 hi lo = Word128 (WW.Word128 hi lo) - --- | Get the most significant 64 bits from a 'Word128' -word128MS64 :: Word128 -> Word64 -word128MS64 (Word128 (WW.Word128 hi _)) = hi - --- | Get the least significant 64 bits from a 'Word128' -word128LS64 :: Word128 -> Word64 -word128LS64 (Word128 (WW.Word128 _ lo)) = lo - -{------------------------------------------------------------------------------- - Instances --------------------------------------------------------------------------------} - -instance ByteSwap Word128 where - byteSwap (Word128 (WW.Word128 hi lo)) = - Word128 $ WW.Word128 (byteSwap64 lo) (byteSwap64 hi) diff --git a/test/Test/Codec/Borsh/Util/Orphans.hs b/test/Test/Codec/Borsh/Util/Orphans.hs --- a/test/Test/Codec/Borsh/Util/Orphans.hs +++ b/test/Test/Codec/Borsh/Util/Orphans.hs @@ -6,35 +6,34 @@ import Data.SOP import qualified Data.Text as Text import Data.Text (Text) +import Data.WideWord.Word128 +import Data.WideWord.Int128 import GHC.TypeLits import Test.QuickCheck hiding (Fn) - import Data.FixedSizeArray (FixedSizeArray) -import Data.Word128 -import Data.Int128 import qualified Data.FixedSizeArray as FSA instance Arbitrary Word128 where - arbitrary = word128 <$> arbitrary <*> arbitrary + arbitrary = Word128 <$> arbitrary <*> arbitrary shrink w128 = concat [ - [word128 hi' lo | hi' <- shrink hi] - , [word128 hi lo' | lo' <- shrink lo] + [Word128 hi' lo | hi' <- shrink hi] + , [Word128 hi lo' | lo' <- shrink lo] ] where - hi = word128MS64 w128 - lo = word128LS64 w128 + hi = word128Hi64 w128 + lo = word128Lo64 w128 instance Arbitrary Int128 where - arbitrary = int128 <$> arbitrary <*> arbitrary + arbitrary = Int128 <$> arbitrary <*> arbitrary shrink i128 = concat [ - [int128 hi' lo | hi' <- shrink hi] - , [int128 hi lo' | lo' <- shrink lo] + [Int128 hi' lo | hi' <- shrink hi] + , [Int128 hi lo' | lo' <- shrink lo] ] where - hi = int128MS64 i128 - lo = int128LS64 i128 + lo = int128Lo64 i128 + hi = int128Hi64 i128 instance Arbitrary Text where arbitrary = Text.pack <$> arbitrary @@ -43,4 +42,3 @@ instance (KnownNat n, Arbitrary a) => Arbitrary (FixedSizeArray n a) where arbitrary = FSA.fromList <$> replicateM (fromIntegral $ natVal (Proxy @n)) arbitrary - diff --git a/test/Test/Codec/Borsh/Util/RandomType.hs b/test/Test/Codec/Borsh/Util/RandomType.hs --- a/test/Test/Codec/Borsh/Util/RandomType.hs +++ b/test/Test/Codec/Borsh/Util/RandomType.hs @@ -18,15 +18,15 @@ import Data.FixedSizeArray (FixedSizeArray) import Data.Foldable (toList) import Data.Int -import Data.Int128 import Data.Kind import Data.Map (Map) import Data.Maybe (mapMaybe, maybeToList) import Data.Profunctor import Data.Set (Set) import Data.Text (Text) +import Data.WideWord.Int128 +import Data.WideWord.Word128 import Data.Word -import Data.Word128 import Generics.SOP import Generics.SOP.Dict import Generics.SOP.NP (map_NP) @@ -371,7 +371,7 @@ shrinkIntegral = ShrinkFun $ return . fromIntegral shrinkU128 :: ShrinkFun Word128 Word64 -shrinkU128 = ShrinkFun $ return . word128LS64 +shrinkU128 = ShrinkFun $ return . word128Lo64 shrinkDouble :: ShrinkFun Double Word64 shrinkDouble = ShrinkFun $ return . castDoubleToWord64