From 9ff0c40876a539f14d4e93b67fa898ff18ba8193 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 14 Nov 2023 22:19:13 +0400 Subject: [PATCH] Replace Data.Binary with Chainweb.Utils.Serialization --- src/Chainweb/Pact/SPV/Hyperlane.hs | 66 +++++------ src/Chainweb/Pact/SPV/Hyperlane/Binary.hs | 138 ++++++++-------------- src/Chainweb/Utils/Serialization.hs | 22 ++++ test/Chainweb/Test/Pact/SPV/Hyperlane.hs | 5 +- 4 files changed, 105 insertions(+), 126 deletions(-) diff --git a/src/Chainweb/Pact/SPV/Hyperlane.hs b/src/Chainweb/Pact/SPV/Hyperlane.hs index 9f0aec1de7..c5b3a894b9 100644 --- a/src/Chainweb/Pact/SPV/Hyperlane.hs +++ b/src/Chainweb/Pact/SPV/Hyperlane.hs @@ -11,18 +11,15 @@ import Control.Monad (when) import Control.Monad.Catch import Control.Monad.Except -import Data.Foldable (foldl') -import Data.DoubleWord -import Data.Decimal -import Data.Ratio import qualified Data.ByteString as B import qualified Data.ByteString.Builder as Builder -import Data.Default (def) import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Short as BS -import qualified Data.ByteString.Lazy as BL -import qualified Data.Binary as Binary -import qualified Data.Binary.Put as Binary +import Data.DoubleWord +import Data.Decimal +import Data.Default (def) +import Data.Foldable (foldl') +import Data.Ratio import qualified Data.Map.Strict as M import Data.Text (Text) import qualified Data.Text as Text @@ -36,6 +33,7 @@ import Ethereum.Misc hiding (Word256) import Pact.Types.Runtime import Chainweb.Pact.SPV.Hyperlane.Binary +import Chainweb.Utils.Serialization (putRawByteString, runPutS, runGetS, putWord32be, putWord256be) -- | Parses the object and evaluates Hyperlane command evalHyperlaneCommand :: Object Name -> ExceptT Text IO (Object Name) @@ -67,35 +65,35 @@ verifySignatures hexMessage hexMetadata validators threshold = do Right s -> pure s Left e -> throwError $ Text.pack $ "Decoding of HyperlaneMessage failed: " ++ e - let HyperlaneMessage{..} = Binary.decode $ BL.fromStrict $ message + HyperlaneMessage{..} <- runGetS getHyperlaneMessage message - metadata <- case BL.fromStrict <$> decodeHex hexMetadata of + metadata <- case decodeHex hexMetadata of Right s -> pure s Left e -> throwError $ Text.pack $ "Decoding of Metadata failed: " ++ e - let MessageIdMultisigIsmMetadata{..} = Binary.decode metadata + MessageIdMultisigIsmMetadata{..} <- runGetS getMessageIdMultisigIsmMetadata metadata let - domainHash = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do + domainHash = getKeccak256Hash $ runPutS $ do -- Corresponds to abi.encodePacked behaviour - Binary.put hmOriginDomain - putBS mmimOriginMerkleTreeAddress - putBS "HYPERLANE" + putWord32be hmOriginDomain + putRawByteString mmimOriginMerkleTreeAddress + putRawByteString "HYPERLANE" let messageId = getKeccak256Hash message let - hash' = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do + hash' = getKeccak256Hash $ runPutS $ do -- Corresponds to abi.encodePacked behaviour - putBS domainHash - putBS mmimSignedCheckpointRoot - Binary.put mmimSignedCheckpointIndex - putBS messageId + putRawByteString domainHash + putRawByteString mmimSignedCheckpointRoot + putWord256be mmimSignedCheckpointIndex + putRawByteString messageId let - digest = keccak256 $ BL.toStrict $ Binary.runPut $ do + digest = keccak256 $ runPutS $ do -- Corresponds to abi.encodePacked behaviour - putBS ethereumHeader - putBS hash' + putRawByteString ethereumHeader + putRawByteString hash' addresses <- catMaybes <$> mapM (recoverHexAddress digest) mmimSignatures @@ -149,16 +147,16 @@ recoverAddressValidatorAnnouncement storageLocation sig = do Left e -> throwError $ Text.pack $ "Decoding of domainHashHex failed: " ++ e let - hash' = getKeccak256Hash $ BL.toStrict $ Binary.runPut $ do + hash' = getKeccak256Hash $ runPutS $ do -- Corresponds to abi.encodePacked behaviour - putBS domainHash - putBS $ Text.encodeUtf8 storageLocation + putRawByteString domainHash + putRawByteString $ Text.encodeUtf8 storageLocation let - announcementDigest = keccak256 $ BL.toStrict $ Binary.runPut $ do + announcementDigest = keccak256 $ runPutS $ do -- Corresponds to abi.encodePacked behaviour - putBS ethereumHeader - putBS hash' + putRawByteString ethereumHeader + putRawByteString hash' address <- recoverHexAddress announcementDigest signatureBinary let addr = fmap (tStr . asString) $ address @@ -188,10 +186,10 @@ encodeHyperlaneMessage o = do hmRecipient <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString . to decodeHex . _Right let hm = HyperlaneMessage{..} - let b = BL.toStrict $ Binary.encode hm - let messageId = encodeHex $ getKeccak256Hash b - let hex = encodeHex b - pure $ mkObject [ ("encodedMessage", tStr $ asString hex), ("messageId", tStr $ asString messageId) ] + let binaryHm = runPutS $ putHyperlaneMessage hm + let messageId = encodeHex $ getKeccak256Hash binaryHm + let hexHm = encodeHex binaryHm + pure $ mkObject [ ("encodedMessage", tStr $ asString hexHm), ("messageId", tStr $ asString messageId) ] case newObj of Just o' -> pure o' _ -> throwError "Couldn't encode HyperlaneMessage" @@ -207,7 +205,7 @@ parseTokenMessageERC20 o = do encodeTokenMessageERC20 :: Object Name -> Maybe Text encodeTokenMessageERC20 o = do tm <- parseTokenMessageERC20 o - let hex = encodeHex $ BL.toStrict $ Binary.encode tm + let hex = encodeHex $ runPutS $ putTokenMessageERC20 tm pure hex -- | Recovers the address from keccak256 encoded digest and signature. diff --git a/src/Chainweb/Pact/SPV/Hyperlane/Binary.hs b/src/Chainweb/Pact/SPV/Hyperlane/Binary.hs index 3156824847..d78c2bcdfe 100644 --- a/src/Chainweb/Pact/SPV/Hyperlane/Binary.hs +++ b/src/Chainweb/Pact/SPV/Hyperlane/Binary.hs @@ -8,15 +8,12 @@ module Chainweb.Pact.SPV.Hyperlane.Binary where import Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL - import Data.DoubleWord import Data.Text (Text) import qualified Data.Text.Encoding as Text -import Data.Binary -import qualified Data.Binary.Builder as Builder -import Data.Binary.Get -import Data.Binary.Put +import Data.Word + +import Chainweb.Utils.Serialization -- | Ethereum address takes 20 bytes ethereumAddressSize :: Int @@ -33,27 +30,28 @@ data HyperlaneMessage = HyperlaneMessage } -- Corresponds to abi.encodePacked behaviour -instance Binary HyperlaneMessage where - put (HyperlaneMessage {..}) = do - put hmVersion - put hmNonce - put hmOriginDomain - putBS (padLeft hmSender) - put hmDestinationDomain - putBS (padLeft hmRecipient) - - put hmTokenMessage - - get = do - hmVersion <- getWord8 - hmNonce <- getWord32be - hmOriginDomain <- getWord32be - hmSender <- BS.takeEnd ethereumAddressSize <$> getBS 32 - hmDestinationDomain <- getWord32be - hmRecipient <- BS.dropWhile (== 0) <$> getBS 32 - hmTokenMessage <- get - - return $ HyperlaneMessage {..} +putHyperlaneMessage :: HyperlaneMessage -> Put +putHyperlaneMessage (HyperlaneMessage {..}) = do + putWord8 hmVersion + putWord32be hmNonce + putWord32be hmOriginDomain + putRawByteString (padLeft hmSender) + putWord32be hmDestinationDomain + putRawByteString (padLeft hmRecipient) + + putTokenMessageERC20 hmTokenMessage + +getHyperlaneMessage :: Get HyperlaneMessage +getHyperlaneMessage = do + hmVersion <- getWord8 + hmNonce <- getWord32be + hmOriginDomain <- getWord32be + hmSender <- BS.takeEnd ethereumAddressSize <$> getBS 32 + hmDestinationDomain <- getWord32be + hmRecipient <- BS.dropWhile (== 0) <$> getBS 32 + hmTokenMessage <- getTokenMessageERC20 + + return $ HyperlaneMessage {..} data TokenMessageERC20 = TokenMessageERC20 { tmRecipient :: Text -- string @@ -68,18 +66,19 @@ data TokenMessageERC20 = TokenMessageERC20 -- 4235663664383937364600000000000000000000000000000000000000000000 -- Corresponds to abi.encode behaviour -instance Binary TokenMessageERC20 where - put (TokenMessageERC20 {..}) = do - -- the first offset is constant - put (64 :: Word256) -- 32 bytes - put tmAmount -- 32 bytes - -- 64 bytes - put recipientSize -- 32 bytes - putBS recipient -- recipientSize - where - (recipient, recipientSize) = padRight $ Text.encodeUtf8 tmRecipient - - get = do +putTokenMessageERC20 :: TokenMessageERC20 -> Put +putTokenMessageERC20 (TokenMessageERC20 {..}) = do + -- the first offset is constant + putWord256be (64 :: Word256) -- 32 bytes + putWord256be tmAmount -- 32 bytes + -- 64 bytes + putWord256be recipientSize -- 32 bytes + putRawByteString recipient -- recipientSize + where + (recipient, recipientSize) = padRight $ Text.encodeUtf8 tmRecipient + +getTokenMessageERC20 :: Get TokenMessageERC20 +getTokenMessageERC20 = do _firstOffset <- getWord256be tmAmount <- getWord256be @@ -104,23 +103,20 @@ data MessageIdMultisigIsmMetadata = MessageIdMultisigIsmMetadata -- 77c3c8d8e6029f65f7f7b0ad8b80fae2b178d14c9a7b228a539349aad0c7b58b -- 1b00000000000000000000000000000000000000000000000000000000000000 -instance Binary MessageIdMultisigIsmMetadata where - put = error "put instance is not implemented for MessageIdMultisigIsmMetadata" +getMessageIdMultisigIsmMetadata :: Get MessageIdMultisigIsmMetadata +getMessageIdMultisigIsmMetadata = do + mmimOriginMerkleTreeAddress <- getBS 32 + mmimSignedCheckpointRoot <- getBS 32 + mmimSignedCheckpointIndex <- getWord256be + _firstOffset <- getWord256be - -- Corresponds to abi.encode behaviour - get = do - mmimOriginMerkleTreeAddress <- getBS 32 - mmimSignedCheckpointRoot <- getBS 32 - mmimSignedCheckpointIndex <- getWord256be - _firstOffset <- getWord256be - - -- we don't care about the size, we know that each signature is 65 bytes long - _signaturesSize <- getWord256be + -- we don't care about the size, we know that each signature is 65 bytes long + signaturesSize <- getWord256be - theRest <- BL.toStrict <$> getRemainingLazyByteString - let mmimSignatures = sliceSignatures theRest + signaturesBytes <- getByteString (fromIntegral signaturesSize) + let mmimSignatures = sliceSignatures signaturesBytes - return $ MessageIdMultisigIsmMetadata{..} + return $ MessageIdMultisigIsmMetadata{..} -- | Pad with zeroes on the left to 32 bytes -- @@ -144,46 +140,10 @@ padRight s = restSize :: Integral a => a -> a restSize size = (32 - size) `mod` 32 --- | Puts bytestring without size using 'Builder'. -putBS :: ByteString -> Put -putBS s = putBuilder $ Builder.fromByteString s - -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes. getBS :: Word256 -> Get BS.ByteString getBS size = (BS.take (fromIntegral size)) <$> getByteString (fromIntegral $ size + restSize size) -instance Binary Word128 where - put (Word128 w1 w2) = do - putWord64be w1 - putWord64be w2 - - get = do - w1 <- getWord64be - w2 <- getWord64be - pure $ Word128 w1 w2 - -putWord128be :: Word128 -> Put -putWord128be = put - -getWord128be :: Get Word128 -getWord128be = get - -instance Binary Word256 where - put (Word256 w1 w2) = do - putWord128be w1 - putWord128be w2 - - get = do - w1 <- getWord128be - w2 <- getWord128be - pure $ Word256 w1 w2 - -putWord256be :: Word256 -> Put -putWord256be = put - -getWord256be :: Get Word256 -getWord256be = get - -- | Signatures are 65 bytes sized, we split the bytestring by 65 symbols segments. sliceSignatures :: ByteString -> [ByteString] sliceSignatures sig' = go sig' [] diff --git a/src/Chainweb/Utils/Serialization.hs b/src/Chainweb/Utils/Serialization.hs index 80112f67ca..8906401789 100644 --- a/src/Chainweb/Utils/Serialization.hs +++ b/src/Chainweb/Utils/Serialization.hs @@ -31,8 +31,13 @@ module Chainweb.Utils.Serialization , getWord64le , putWord64be , getWord64be + , putWord128be + , getWord128be + , putWord256be + , getWord256be , putByteString , getByteString + , putRawByteString -- abstract encoders and decoders , WordEncoding(..) @@ -57,6 +62,7 @@ import qualified Data.Text as T import Data.Word import qualified Data.Binary as Binary +import qualified Data.Binary.Builder as Builder import qualified Data.Binary.Get as Binary import qualified Data.Binary.Put as Binary @@ -147,6 +153,22 @@ getByteString = coerce Binary.getByteString putByteString :: B.ByteString -> Put putByteString = coerce Binary.putByteString +putWord128be :: Word128 -> Put +putWord128be = encodeWordBe + +getWord128be :: Get Word128 +getWord128be = decodeWordBe + +putWord256be :: Word256 -> Put +putWord256be = encodeWordBe + +getWord256be :: Get Word256 +getWord256be = decodeWordBe + +-- | Puts bytestring without size using 'Builder'. +putRawByteString :: B.ByteString -> Put +putRawByteString = coerce (Binary.putBuilder . Builder.fromByteString) + -------------------- -- Abstract encoders/decoders -------------------- diff --git a/test/Chainweb/Test/Pact/SPV/Hyperlane.hs b/test/Chainweb/Test/Pact/SPV/Hyperlane.hs index b4f4161f8c..94f7c07f2c 100644 --- a/test/Chainweb/Test/Pact/SPV/Hyperlane.hs +++ b/test/Chainweb/Test/Pact/SPV/Hyperlane.hs @@ -16,8 +16,6 @@ module Chainweb.Test.Pact.SPV.Hyperlane ) where import Control.Monad.Trans.Except -import qualified Data.ByteString.Lazy as BL -import qualified Data.Binary as Binary import Data.Text (Text) import Test.Tasty @@ -33,6 +31,7 @@ import Pact.Types.Util (AsString(..)) import Chainweb.Pact.SPV.Hyperlane import Chainweb.Pact.SPV.Hyperlane.Binary +import Chainweb.Utils.Serialization (runGetS) tests :: TestTree tests = testGroup "hyperlane" @@ -73,8 +72,8 @@ hyperlaneDecodeTokenMessageERC20 = do encodedBinary <- case decodeHex encodedMessage of Right r -> pure r Left _ -> assertFailure "hyperlaneDecodeTokenMessageERC20: failed to decode" + tm <- runGetS getTokenMessageERC20 encodedBinary let - tm = Binary.decode $ BL.fromStrict encodedBinary expectedObject = TokenMessageERC20 "recipient" 3333333333333333333 assertEqual "Should properly decode the object" expectedObject tm