From 7b6a5205594c20f729a2b7b0868fa2a3056218cf Mon Sep 17 00:00:00 2001 From: martyall Date: Sun, 21 Apr 2024 08:07:53 -0700 Subject: [PATCH] remove bytestring deps --- packages.dhall | 8 ++--- spago.dhall | 4 +-- src/Network/Ethereum/Web3.purs | 4 +-- src/Network/Ethereum/Web3/Solidity.purs | 6 ++-- .../Ethereum/Web3/Solidity/AbiEncoding.purs | 27 ++++++++-------- src/Network/Ethereum/Web3/Solidity/Bytes.purs | 25 ++++++++------- test.dhall | 1 - .../Web3Spec/Encoding/ContainersSpec.purs | 6 ++-- test/web3/Web3Spec/Live/RPCSpec.purs | 32 +++++++++---------- 9 files changed, 55 insertions(+), 58 deletions(-) diff --git a/packages.dhall b/packages.dhall index ccd144e..6a239c7 100644 --- a/packages.dhall +++ b/packages.dhall @@ -7,8 +7,7 @@ let eth-core-deps = sha256:af2751772a729d58edf7056805007934e3687b3079f8a02ac514e705aeab8c42 let additions = - { bytestrings = eth-core-deps.bytestrings - , coroutine-transducers = + { coroutine-transducers = { dependencies = [ "console", "either", @@ -34,7 +33,6 @@ let additions = { dependencies = [ "argonaut" , "arrays" - , "bytestrings" , "effect" , "either" , "foldable-traversable" @@ -51,16 +49,14 @@ let additions = , "ordered-collections" , "partial" , "prelude" - , "quotient" , "simple-json" , "strings" , "unfoldable" , "unsafe-coerce" ] , repo = "https://github.com/f-o-a-m/purescript-eth-core" - , version = "v10.1.0" + , version = "remove-bs-dep" } - , quotient = eth-core-deps.quotient } in upstream // additions diff --git a/spago.dhall b/spago.dhall index 38a12cd..c4a9f67 100644 --- a/spago.dhall +++ b/spago.dhall @@ -4,7 +4,6 @@ , "argonaut" , "arrays" , "bifunctors" - , "bytestrings" , "control" , "coroutine-transducers" , "coroutines" @@ -18,8 +17,10 @@ , "fork" , "gen" , "heterogeneous" + , "identity" , "maybe" , "newtype" + , "node-buffer" , "parallel" , "parsing" , "partial" @@ -37,7 +38,6 @@ , "unfoldable" , "unsafe-coerce" , "variant" - , "identity" ] , packages = ./packages.dhall , sources = [ "src/**/*.purs" ] diff --git a/src/Network/Ethereum/Web3.purs b/src/Network/Ethereum/Web3.purs index 274228c..c32b1ab 100644 --- a/src/Network/Ethereum/Web3.purs +++ b/src/Network/Ethereum/Web3.purs @@ -11,11 +11,11 @@ import Network.Ethereum.Web3.Contract.Events (event', EventHandler, MultiFilterS import Network.Ethereum.Web3.Solidity ( Address , BigNumber - , ByteString + , ImmutableBuffer , BytesN , UIntN , Vector - , fromByteString + , fromBuffer , abiDecode , intNFromBigNumber , nilVector diff --git a/src/Network/Ethereum/Web3/Solidity.purs b/src/Network/Ethereum/Web3/Solidity.purs index 7cfd895..fc1a572 100644 --- a/src/Network/Ethereum/Web3/Solidity.purs +++ b/src/Network/Ethereum/Web3/Solidity.purs @@ -8,13 +8,13 @@ module Network.Ethereum.Web3.Solidity , module Network.Ethereum.Web3.Solidity.AbiEncoding , module Network.Ethereum.Web3.Solidity.Event , module Network.Ethereum.Types - , module Data.ByteString + , module Node.Buffer.Immutable ) where -import Data.ByteString (ByteString) +import Node.Buffer.Immutable (ImmutableBuffer) import Network.Ethereum.Types (BigNumber, Address) import Network.Ethereum.Web3.Solidity.AbiEncoding (class ABIDecode, class ABIEncode, class EncodingType, abiDecode, isDynamic, abiEncode) -import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, proxyBytesN, update, fromByteString) +import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, proxyBytesN, update, fromBuffer) import Network.Ethereum.Web3.Solidity.Event (class DecodeEvent, decodeEvent, class IndexedEvent, isAnonymous) import Network.Ethereum.Web3.Solidity.Int (IntN, unIntN, intNFromBigNumber) import Network.Ethereum.Web3.Solidity.Internal (class RecordFieldsIso, fromRecord, toRecord) diff --git a/src/Network/Ethereum/Web3/Solidity/AbiEncoding.purs b/src/Network/Ethereum/Web3/Solidity/AbiEncoding.purs index 203dba1..5eec6e9 100644 --- a/src/Network/Ethereum/Web3/Solidity/AbiEncoding.purs +++ b/src/Network/Ethereum/Web3/Solidity/AbiEncoding.purs @@ -16,9 +16,10 @@ module Network.Ethereum.Web3.Solidity.AbiEncoding import Prelude +import Node.Encoding (Encoding(UTF8)) import Data.Array (foldMap, foldl, length, sortBy, (:)) -import Data.ByteString (ByteString) -import Data.ByteString (toUTF8, fromUTF8, length) as BS +import Node.Buffer.Immutable (ImmutableBuffer) +import Node.Buffer.Immutable as B import Data.Either (Either) import Data.Functor.Tagged (Tagged, tagged, untagged) import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, repOf, to) @@ -32,7 +33,7 @@ import Data.Traversable (foldMapDefaultR) import Data.Tuple (Tuple(..)) import Data.Unfoldable (replicateA) import Network.Ethereum.Core.BigNumber (fromString, fromTwosComplement, toString, toTwosComplement, unsafeToInt) -import Network.Ethereum.Core.HexString (HexString, PadByte(..), fromByteString, mkHexString, numberOfBytes, padLeft, padRight, splitAtByteOffset, toByteString, unHex) +import Network.Ethereum.Core.HexString (HexString, PadByte(..), fromBuffer, mkHexString, numberOfBytes, padLeft, padRight, splitAtByteOffset, toBuffer, unHex) import Network.Ethereum.Types (Address, BigNumber, fromInt, mkAddress, unAddress) import Network.Ethereum.Web3.Solidity.Bytes (BytesN, unBytesN, update, proxyBytesN) import Network.Ethereum.Web3.Solidity.Int (IntN, unIntN, intNFromBigNumber) @@ -67,7 +68,7 @@ else instance EncodingType (BytesN n) where isDynamic = const false else instance EncodingType a => EncodingType (Vector n a) where isDynamic _ = isDynamic (Proxy :: Proxy a) -else instance EncodingType ByteString where +else instance EncodingType ImmutableBuffer where isDynamic = const true else instance EncodingType a => EncodingType (Tagged s a) where isDynamic _ = isDynamic (Proxy :: Proxy a) @@ -114,11 +115,11 @@ else instance Reflectable n Int => ABIEncode (BytesN n) where else instance Reflectable n Int => ABIEncode (IntN n) where abiEncode a = int256HexBuilder <<< unIntN $ a -else instance ABIEncode ByteString where - abiEncode bytes = uInt256HexBuilder (fromInt $ BS.length bytes) <> bytesBuilder bytes +else instance ABIEncode ImmutableBuffer where + abiEncode bytes = uInt256HexBuilder (fromInt $ B.size bytes) <> bytesBuilder bytes else instance ABIEncode String where - abiEncode = abiEncode <<< BS.toUTF8 + abiEncode = abiEncode <<< \a -> B.fromString a UTF8 else instance ABIEncode a => ABIEncode (Array a) where abiEncode l = @@ -221,8 +222,8 @@ factorBuilder a = Endo \encoded -> } : map (\x -> x { order = x.order + 1 }) encoded -- | base16 encode, then utf8 encode, then pad -bytesBuilder :: ByteString -> HexString -bytesBuilder = padRight Zero <<< fromByteString +bytesBuilder :: ImmutableBuffer -> HexString +bytesBuilder = padRight Zero <<< fromBuffer -- | Encode something that is essentaially a signed integer. int256HexBuilder :: BigNumber -> HexString @@ -267,13 +268,13 @@ else instance ABIDecode Address where maddr <- mkAddress <$> parseBytes 20 maybe (fail "Address is 20 bytes, receieved more") pure maddr -else instance ABIDecode ByteString where +else instance ABIDecode ImmutableBuffer where _abiDecode = do len <- _abiDecode - toByteString <$> parseBytes len + toBuffer <$> parseBytes len else instance ABIDecode String where - _abiDecode = BS.fromUTF8 <$> _abiDecode + _abiDecode = B.toString UTF8 <$> _abiDecode else instance Reflectable n Int => ABIDecode (BytesN n) where _abiDecode = do @@ -282,7 +283,7 @@ else instance Reflectable n Int => ABIDecode (BytesN n) where zeroBytes = 32 - len raw <- parseBytes len _ <- parseBytes zeroBytes - pure <<< update proxyBytesN <<< toByteString $ raw + pure <<< update proxyBytesN <<< toBuffer $ raw else instance (Reflectable n Int, ABIDecode a) => ABIDecode (Vector n a) where _abiDecode = diff --git a/src/Network/Ethereum/Web3/Solidity/Bytes.purs b/src/Network/Ethereum/Web3/Solidity/Bytes.purs index 1afae38..74dc193 100644 --- a/src/Network/Ethereum/Web3/Solidity/Bytes.purs +++ b/src/Network/Ethereum/Web3/Solidity/Bytes.purs @@ -3,15 +3,16 @@ module Network.Ethereum.Web3.Solidity.Bytes , unBytesN , proxyBytesN , update - , fromByteString + , fromBuffer , generator ) where import Prelude import Control.Monad.Gen (class MonadGen) -import Data.ByteString (empty, ByteString, Encoding(Hex)) -import Data.ByteString as BS +import Node.Buffer.Immutable (ImmutableBuffer) +import Node.Buffer.Immutable as B +import Node.Encoding (Encoding(Hex)) import Data.Maybe (Maybe(..), fromJust) import Data.Reflectable (class Reflectable, reflectType) import Network.Ethereum.Core.HexString as Hex @@ -24,32 +25,32 @@ import Type.Proxy (Proxy(..)) -------------------------------------------------------------------------------- -- Represents a statically sized bytestring of size `n` bytes. -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. -newtype BytesN (n :: Int) = BytesN ByteString +newtype BytesN (n :: Int) = BytesN ImmutableBuffer derive newtype instance eqBytesN :: Eq (BytesN n) instance showBytesN :: Show (BytesN n) where - show (BytesN bs) = show <<< unsafePartial fromJust <<< mkHexString $ BS.toString bs Hex + show (BytesN bs) = show <<< unsafePartial fromJust <<< mkHexString $ B.toString Hex bs generator :: forall n m. Reflectable n Int => MonadGen m => Proxy n -> m (BytesN n) generator p = do bs <- Hex.generator (reflectType p) - pure $ BytesN $ Hex.toByteString bs + pure $ BytesN $ Hex.toBuffer bs -- | Access the underlying raw bytestring -unBytesN :: forall n. BytesN n -> ByteString +unBytesN :: forall n. BytesN n -> ImmutableBuffer unBytesN (BytesN bs) = bs proxyBytesN :: forall n. BytesN n -proxyBytesN = BytesN empty +proxyBytesN = BytesN $ B.fromArray [] -update :: forall n. BytesN n -> ByteString -> BytesN n +update :: forall n. BytesN n -> ImmutableBuffer -> BytesN n update _ = BytesN -- | Attempt to coerce a bytestring into one of the appropriate size. -- | See module [Network.Ethereum.Web3.Solidity.Sizes](/Network.Ethereum.Web3.Solidity.Sizes) for some predefined sizes. -fromByteString :: forall proxy n. Reflectable n Int => proxy n -> ByteString -> Maybe (BytesN n) -fromByteString _ bs = - if not $ BS.length bs <= reflectType (Proxy :: Proxy n) then +fromBuffer :: forall proxy n. Reflectable n Int => proxy n -> ImmutableBuffer -> Maybe (BytesN n) +fromBuffer _ bs = + if not $ B.size bs <= reflectType (Proxy :: Proxy n) then Nothing else Just $ BytesN bs diff --git a/test.dhall b/test.dhall index 2138927..7008b0d 100644 --- a/test.dhall +++ b/test.dhall @@ -13,7 +13,6 @@ in conf , "nonempty" , "quickcheck" , "quickcheck-laws" - , "quotient" , "spec" , "unsafe-coerce" ] diff --git a/test/web3/Web3Spec/Encoding/ContainersSpec.purs b/test/web3/Web3Spec/Encoding/ContainersSpec.purs index 7fd2649..d73fc38 100644 --- a/test/web3/Web3Spec/Encoding/ContainersSpec.purs +++ b/test/web3/Web3Spec/Encoding/ContainersSpec.purs @@ -54,7 +54,7 @@ typePropertyTests = it "can encode/decode bytestring" $ liftEffect $ do quickCheckGen $ do n <- chooseInt 1 100 - x <- Hex.toByteString <$> Hex.generator n + x <- Hex.toBuffer <$> Hex.generator n pure $ encodeDecode x === Right x it "can encode/decode bool" $ liftEffect $ do @@ -300,7 +300,7 @@ tupleTests = do reifyType m \pm -> reifyType k \pk -> do ints <- arrayOf (IntN.generator pn) - bytes <- Hex.toByteString <$> (chooseInt 1 100 >>= Hex.generator) + bytes <- Hex.toBuffer <$> (chooseInt 1 100 >>= Hex.generator) addrs <- Vector.generator pm (arrayOf Address.generator) strings <- arrayOf (Vector.generator pk (arbitrary @BMPString)) bool <- arbitrary :: Gen Boolean @@ -364,7 +364,7 @@ tupleTests = do let mkTuple5 = do ints <- arrayOf (IntN.generator _pn) - bytes <- Hex.toByteString <$> (chooseInt 1 100 >>= Hex.generator) + bytes <- Hex.toBuffer <$> (chooseInt 1 100 >>= Hex.generator) addrs <- Vector.generator _pm (arrayOf Address.generator) strings <- map (map (un BMPString)) <$> arrayOf (Vector.generator _pk (arbitrary @BMPString)) diff --git a/test/web3/Web3Spec/Live/RPCSpec.purs b/test/web3/Web3Spec/Live/RPCSpec.purs index bd0a4b3..8be456f 100644 --- a/test/web3/Web3Spec/Live/RPCSpec.purs +++ b/test/web3/Web3Spec/Live/RPCSpec.purs @@ -1,8 +1,9 @@ module Web3Spec.Live.RPCSpec (spec) where import Prelude -import Data.Array ((!!)) -import Data.ByteString as BS +import Data.Array ((!!), last) +import Node.Buffer.Immutable as B +import Node.Encoding (Encoding(UTF8)) import Data.Either (isRight) import Data.Lens ((?~), (%~)) import Data.Maybe (Maybe(..), fromJust) @@ -13,11 +14,9 @@ import Network.Ethereum.Core.Keccak256 (keccak256) import Network.Ethereum.Core.Signatures as Sig import Network.Ethereum.Web3 (Block(..), ChainCursor(..), Provider, TransactionReceipt(..), _from, _to, _value, convert, defaultTransactionOptions, fromMinorUnit, mkHexString, runWeb3) import Network.Ethereum.Web3.Api as Api -import Node.Buffer.Class (slice) import Partial.Unsafe (unsafePartial) import Test.Spec (SpecT, describe, it) import Test.Spec.Assertions (shouldEqual, shouldSatisfy) -import Type.Quotient (runQuotient) import Web3Spec.Live.Utils (assertWeb3, pollTransactionReceipt) spec :: Provider -> SpecT Aff Unit Aff Unit @@ -111,7 +110,7 @@ spec provider = signer `shouldEqual` signer' -- make sure that we can recover the signature in purescript natively let - rsvSignature = case signatureFromByteString <<< Hex.toByteString $ signatureHex of + rsvSignature = case signatureFromByteString <<< Hex.toBuffer $ signatureHex of Sig.Signature sig -> Sig.Signature sig { v = sig.v - 27 } Sig.publicToAddress (Sig.recoverSender fullHashedMessageBS rsvSignature) `shouldEqual` signer it "Can call eth_estimateGas" do @@ -141,16 +140,15 @@ spec provider = pure $ Tuple tx tx' tx `shouldEqual` tx' -signatureFromByteString :: BS.ByteString -> Sig.Signature -signatureFromByteString bs = +signatureFromByteString :: B.ImmutableBuffer -> Sig.Signature +signatureFromByteString bfr = let - bfr = BS.unsafeThaw bs - r = Hex.fromByteString $ BS.unsafeFreeze $ slice 0 32 bfr + r = Hex.fromBuffer $ B.slice 0 32 bfr - s = Hex.fromByteString $ BS.unsafeFreeze $ slice 32 64 bfr + s = Hex.fromBuffer $ B.slice 32 64 bfr - v = runQuotient $ unsafePartial fromJust $ BS.last bs + v = unsafePartial fromJust $ last $ B.toArray bfr in Sig.Signature { r, s, v } @@ -158,11 +156,13 @@ makeRidiculousEthereumMessage :: Hex.HexString -> Hex.HexString makeRidiculousEthereumMessage s = let prefix = - Hex.fromByteString - $ BS.toUTF8 - $ "\x19" -- NOTE: 19 in hexadecimal is 25 + Hex.fromBuffer + $ B.fromString + ( "\x19" -- NOTE: 19 in hexadecimal is 25 - <> "Ethereum Signed Message:\n" -- NOTE: length of this string is 25 - <> show (Hex.numberOfBytes s) + <> "Ethereum Signed Message:\n" -- NOTE: length of this string is 25 + <> show (Hex.numberOfBytes s) + ) + UTF8 in prefix <> s