From 9c3f01514b5ce442a474d1e3c9b20aa3dd633a77 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Tue, 20 Feb 2024 16:42:03 -0800 Subject: [PATCH 01/20] Add hyperlane-decode-token-message with gas --- pact.cabal | 2 ++ src/Pact/Gas/Table.hs | 5 +++ src/Pact/Native.hs | 79 +++++++++++++++++++++++++++++++++++++++++++ src/Pact/Types/Gas.hs | 4 +++ 4 files changed, 90 insertions(+) diff --git a/pact.cabal b/pact.cabal index 8fba2af61..26dea73ef 100644 --- a/pact.cabal +++ b/pact.cabal @@ -207,6 +207,7 @@ library , base >= 4.18.0.0 , base16-bytestring >=0.1.1.6 , base64-bytestring >=1.0.0.1 + , binary -- base64-bytestring >=1.2.0.0 is less lenient then previous versions, which can cause pact failures (e.g. (env-hash "aa")) , bound >=2 , bytestring >=0.10.8.1 @@ -220,6 +221,7 @@ library , deriving-compat >=0.5.1 , direct-sqlite >=2.3.27 , directory >=1.2.6.2 + , data-dword , errors >=2.3 , exceptions >=0.8.3 , filepath >=1.4.1.0 diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 0b1fd40e3..cac82e70c 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -56,6 +56,7 @@ data GasCostConfig = GasCostConfig , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas + , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes :: MilliGas } defaultGasConfig :: GasCostConfig @@ -83,6 +84,7 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50 , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38 , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47 + , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 1 -- TODO: Benchmark } defaultGasTable :: Map Text Gas @@ -339,6 +341,9 @@ tableGasModel gasConfig = GHyperlaneMessageId len -> let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes gasConfig in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100) + GHyperlaneDecodeTokenMessage len -> + let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes gasConfig + in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100) in GasModel { gasModelName = "table" diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 7208a4840..7669135b5 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} -- | @@ -64,17 +65,21 @@ import Control.Monad import Control.Monad.IO.Class import qualified Data.Attoparsec.Text as AP import Data.Bifunctor (first) +import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString) import Data.Bool (bool) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.Char as Char import Data.Bits +import Data.Decimal (Decimal) import Data.Default +import Data.DoubleWord (Word128(..), Word256(..)) import Data.Functor(($>)) import Data.Foldable import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M import qualified Data.List as L (nubBy) +import Data.Ratio ((%)) import qualified Data.Set as S import Data.Text (Text, pack, unpack) import qualified Data.Text as T @@ -1579,6 +1584,7 @@ poseidonHackAChainDef = defGasRNative hyperlaneDefs :: NativeModule hyperlaneDefs = ("Hyperlane",) [ hyperlaneMessageIdDef + , hyperlaneDecodeTokenMessageDef ] hyperlaneMessageIdDef :: NativeDef @@ -1609,3 +1615,76 @@ hyperlaneMessageIdDef = defGasRNative case mRecipient of Nothing -> error "couldn't decode token recipient" Just t -> T.encodeUtf8 t + +hyperlaneDecodeTokenMessageDef :: NativeDef +hyperlaneDecodeTokenMessageDef = + defGasRNative + "hyperlane-decode-tokenmessage" + hyperlaneDecodeTokenMessageDef' + (funType tTyObjectAny [("x", tTyString)]) + ["(TODO example)"] + "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:STRING, amount:DECIMAL, chainId:STRING}`." + where + hyperlaneDecodeTokenMessageDef' :: RNativeFun e + hyperlaneDecodeTokenMessageDef' i args = case args of + + [TLitString msg] -> + -- We do not need to handle historical b64 error message shimming + -- or decoding from non-canonical strings in this base-64 decoder, + -- because this native is added in a Pact version that latre than when + -- we moved to base64-bytestring >= 1.0, which behaves succeeds and + -- fails in exactly the cases we expect. + -- (The only change we make to its output is to strip error messages). + -- TODO: standard alphabet, or URL? + computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ + case B64.decode (T.encodeUtf8 msg) of + Left _ -> evalError' i $ "Failed to base64-decode token message" + Right bytes -> do + sourceChain <- ifExecutionFlagSet FlagDisablePact40 (pure $ toTerm @Text "none") $ + fmap toTerm $ view $ eePublicData . pdPublicMeta . pmChainId + case runGetOrFail getTokenMessageERC20 (BS.fromStrict bytes) of + -- In case of Binary decoding failure, emit a terse error message. + -- This protects us from exposure to changes in Binary's message + -- format. (TODO: Do we suppress error messages on-chain anyway?) + Left _ -> evalError' i $ "Failed to decode TokenMessage bytes" + -- TODO: Do we need to assert that the bytes are fully consumed + -- by parsing? + -- TODO: Is this format correct? I.e. field names? + Right (_,_,(recipient, amount)) -> + pure $ toTObject TyAny def + [("recipient", TLiteral (LString recipient) def) + ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def) + ,("chainId", sourceChain) + ] + _ -> argsError i args + + -- The TokenMessage contains a recipient (text) and an amount (word-256). + getTokenMessageERC20 :: Get (Text, Word256) + getTokenMessageERC20 = do + _firstOffset <- getWord256be + tmAmount <- getWord256be + + recipientSize <- getWord256be + tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize + return $ (tmRecipient, tmAmount) + where + getWord256be = Word256 <$> getWord128be <*> getWord128be + getWord128be = Word128 <$> getWord64be <*> getWord64be + + -- TODO: We check the size. Is this ok? + -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes. + getRecipient :: Word256 -> Get BS.ByteString + getRecipient size = do + recipient <- BS.take (fromIntegral size) <$> getByteString (fromIntegral $ size + restSize size) + if BS.length recipient < fromIntegral size + then fail "Recipient was smaller than expected" + else pure recipient + + -- | Returns the modular of 32 bytes. + restSize :: Integral a => a -> a + restSize size = (32 - size) `mod` 32 + + wordToDecimal :: Word256 -> Decimal + wordToDecimal w = + let ethInWei = 1000000000000000000 -- 1e18 + in fromRational (toInteger w % ethInWei) \ No newline at end of file diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index 1aeb8e48a..df7325417 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -186,6 +186,9 @@ data GasArgs -- ^ Cost of the hyperlane-message-id on this size (in bytes) of the -- hyperlane TokenMessage Recipient, which is the only variable-length -- part of a HyperlaneMessage + | GHyperlaneDecodeTokenMessage !Int + -- ^ Cost of hyperlane-decode-tokenmessage on this size (in bytes) of the + -- hyperlane TokenMessage base64-encoded string. data IntOpThreshold = Pact43IntThreshold @@ -255,6 +258,7 @@ instance Pretty GasArgs where GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args) GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len GHyperlaneMessageId len -> "GHyperlaneMessageId:" <> pretty len + GHyperlaneDecodeTokenMessage len -> "GHyperlaneDecodeTokenMessage:" <> pretty len newtype GasLimit = GasLimit ParsedInteger deriving (Eq,Ord,Generic) From 0774acae12a13282b560dd0056edf8470833afba Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 09:33:57 -0800 Subject: [PATCH 02/20] include chainid in TokenMessage encoding --- src/Pact/Native.hs | 70 ++++++++++++++----- ...perlane-message-id.repl => hyperlane.pact} | 2 +- 2 files changed, 55 insertions(+), 17 deletions(-) rename tests/pact/{hyperlane-message-id.repl => hyperlane.pact} (93%) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 7669135b5..311077b83 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -56,6 +56,7 @@ module Pact.Native , describeNamespaceSchema , dnUserGuard, dnAdminGuard, dnNamespaceName , cdPrevBlockHash + , encodeTokenMessage ) where import Control.Arrow hiding (app, first) @@ -66,9 +67,11 @@ import Control.Monad.IO.Class import qualified Data.Attoparsec.Text as AP import Data.Bifunctor (first) import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString) +import Data.Binary.Put (Put, runPut, putWord64be, putByteString) import Data.Bool (bool) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.Char as Char import Data.Bits import Data.Decimal (Decimal) @@ -76,6 +79,7 @@ import Data.Default import Data.DoubleWord (Word128(..), Word256(..)) import Data.Functor(($>)) import Data.Foldable +import Data.List (isPrefixOf) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M import qualified Data.List as L (nubBy) @@ -1637,36 +1641,44 @@ hyperlaneDecodeTokenMessageDef = -- (The only change we make to its output is to strip error messages). -- TODO: standard alphabet, or URL? computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ - case B64.decode (T.encodeUtf8 msg) of + case B64URL.decode (T.encodeUtf8 msg) of Left _ -> evalError' i $ "Failed to base64-decode token message" Right bytes -> do - sourceChain <- ifExecutionFlagSet FlagDisablePact40 (pure $ toTerm @Text "none") $ - fmap toTerm $ view $ eePublicData . pdPublicMeta . pmChainId case runGetOrFail getTokenMessageERC20 (BS.fromStrict bytes) of -- In case of Binary decoding failure, emit a terse error message. - -- This protects us from exposure to changes in Binary's message - -- format. (TODO: Do we suppress error messages on-chain anyway?) - Left _ -> evalError' i $ "Failed to decode TokenMessage bytes" + -- If the error message begins with TokenError, we know that we + -- created it, and it is going to be stable (non-forking). + -- If it does not start with TokenMessage, it may have come from + -- the Binary library, and we will suppress it to shield ourselves + -- from forking behavior if we update our Binary version. + -- (TODO: Do we suppress error messages on-chain anyway?) + Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e + Left _ -> evalError' i "Decoding error: binary decoding failed" -- TODO: Do we need to assert that the bytes are fully consumed -- by parsing? -- TODO: Is this format correct? I.e. field names? - Right (_,_,(recipient, amount)) -> + Right (_,_,(amount, chain, recipient)) -> pure $ toTObject TyAny def [("recipient", TLiteral (LString recipient) def) ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def) - ,("chainId", sourceChain) + ,("chainId", toTerm chain) ] _ -> argsError i args -- The TokenMessage contains a recipient (text) and an amount (word-256). - getTokenMessageERC20 :: Get (Text, Word256) + getTokenMessageERC20 :: Get (Word256, ChainId, Text) getTokenMessageERC20 = do - _firstOffset <- getWord256be + + -- Parse the size of the following amount field. + amountSize <- fromIntegral @Word256 @Int <$> getWord256be + unless (amountSize == 96) + (fail $ "TokenMessage amountSize expected 96, found " ++ show amountSize) tmAmount <- getWord256be + tmChainId <- getWord256be recipientSize <- getWord256be tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize - return $ (tmRecipient, tmAmount) + return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient) where getWord256be = Word256 <$> getWord128be <*> getWord128be getWord128be = Word128 <$> getWord64be <*> getWord64be @@ -1677,14 +1689,40 @@ hyperlaneDecodeTokenMessageDef = getRecipient size = do recipient <- BS.take (fromIntegral size) <$> getByteString (fromIntegral $ size + restSize size) if BS.length recipient < fromIntegral size - then fail "Recipient was smaller than expected" + then fail "TokenMessage recipient was smaller than expected" else pure recipient - -- | Returns the modular of 32 bytes. - restSize :: Integral a => a -> a - restSize size = (32 - size) `mod` 32 wordToDecimal :: Word256 -> Decimal wordToDecimal w = let ethInWei = 1000000000000000000 -- 1e18 - in fromRational (toInteger w % ethInWei) \ No newline at end of file + in fromRational (toInteger w % ethInWei) + +encodeTokenMessage :: BS.ByteString -> Word256 -> Word256 -> Text +encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encode (BS.toStrict bytes) + where + bytes = runPut $ do + putWord256be (96 :: Word256) + putWord256be amount + putWord256be chain + putWord256be recipientSize + putByteString recipientBytes + + (recipientBytes, recipientSize) = padRight recipient + + putWord256be :: Word256 -> Put + putWord256be (Word256 x y) = putWord128be x >> putWord128be y + + putWord128be :: Word128 -> Put + putWord128be (Word128 x y) = putWord64be x >> putWord64be y + +padRight :: BS.ByteString -> (BS.ByteString, Word256) +padRight s = + let + size = BS.length s + missingZeroes = restSize size + in (s <> BS.replicate missingZeroes 0, fromIntegral size) + +-- | Returns the modular of 32 bytes. +restSize :: Integral a => a -> a +restSize size = (32 - size) `mod` 32 \ No newline at end of file diff --git a/tests/pact/hyperlane-message-id.repl b/tests/pact/hyperlane.pact similarity index 93% rename from tests/pact/hyperlane-message-id.repl rename to tests/pact/hyperlane.pact index 1fcfd5ee2..6cc244560 100644 --- a/tests/pact/hyperlane-message-id.repl +++ b/tests/pact/hyperlane.pact @@ -1,3 +1,3 @@ -;; Test hyperlane-message-id +;; Test hyperlane builtins. (expect "computes the correct message id" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1})) From 53494f759da2608a81191d82d58202e4fe7ff299 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 10:01:03 -0800 Subject: [PATCH 03/20] add principal check for recipient --- src/Pact/Native.hs | 14 +++++++++++--- tests/pact/hyperlane.pact | 3 --- tests/pact/hyperlane.repl | 20 ++++++++++++++++++++ 3 files changed, 31 insertions(+), 6 deletions(-) delete mode 100644 tests/pact/hyperlane.pact create mode 100644 tests/pact/hyperlane.repl diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 311077b83..d89c82eef 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -77,6 +77,7 @@ import Data.Bits import Data.Decimal (Decimal) import Data.Default import Data.DoubleWord (Word128(..), Word256(..)) +import Data.Either (isRight) import Data.Functor(($>)) import Data.Foldable import Data.List (isPrefixOf) @@ -112,6 +113,7 @@ import Pact.Types.Hash import Pact.Types.Names import Pact.Types.PactValue import Pact.Types.Pretty hiding (list) +import Pact.Types.Principal (principalParser) import Pact.Types.Purity import Pact.Types.Runtime import Pact.Types.Version @@ -1644,7 +1646,7 @@ hyperlaneDecodeTokenMessageDef = case B64URL.decode (T.encodeUtf8 msg) of Left _ -> evalError' i $ "Failed to base64-decode token message" Right bytes -> do - case runGetOrFail getTokenMessageERC20 (BS.fromStrict bytes) of + case runGetOrFail (getTokenMessageERC20 (getInfo i)) (BS.fromStrict bytes) of -- In case of Binary decoding failure, emit a terse error message. -- If the error message begins with TokenError, we know that we -- created it, and it is going to be stable (non-forking). @@ -1666,8 +1668,8 @@ hyperlaneDecodeTokenMessageDef = _ -> argsError i args -- The TokenMessage contains a recipient (text) and an amount (word-256). - getTokenMessageERC20 :: Get (Word256, ChainId, Text) - getTokenMessageERC20 = do + getTokenMessageERC20 :: Info -> Get (Word256, ChainId, Text) + getTokenMessageERC20 i = do -- Parse the size of the following amount field. amountSize <- fromIntegral @Word256 @Int <$> getWord256be @@ -1678,6 +1680,10 @@ hyperlaneDecodeTokenMessageDef = recipientSize <- getWord256be tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize + + unless (isRight (AP.parseOnly (principalParser i) tmRecipient)) $ + fail $ "TokenMessage recipient is not a valid principal." + return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient) where getWord256be = Word256 <$> getWord128be <*> getWord128be @@ -1698,6 +1704,8 @@ hyperlaneDecodeTokenMessageDef = let ethInWei = 1000000000000000000 -- 1e18 in fromRational (toInteger w % ethInWei) +-- | Helper function for creating TokenMessages encoded in the ERC20 format +-- and base64url encoded. Used for generating test data. encodeTokenMessage :: BS.ByteString -> Word256 -> Word256 -> Text encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encode (BS.toStrict bytes) where diff --git a/tests/pact/hyperlane.pact b/tests/pact/hyperlane.pact deleted file mode 100644 index 6cc244560..000000000 --- a/tests/pact/hyperlane.pact +++ /dev/null @@ -1,3 +0,0 @@ -;; Test hyperlane builtins. - -(expect "computes the correct message id" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1})) diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl new file mode 100644 index 000000000..69c3f5f6b --- /dev/null +++ b/tests/pact/hyperlane.repl @@ -0,0 +1,20 @@ +;; Test hyperlane builtins. + +(expect "computes the correct message id" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1})) + +; Decoding a valid TokenMessage should succeed. +(expect "decodes the correct TokenMessage" + { "amount":0.000000000000000123, + "chainId": "4", + "recipient": "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69" + } + (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") +) + +; This TokenMessage was encoded with the recipient "greg". It should fail +; to decode because "greg" is not a valid principal. (Recipient must be a +; valid principal). +(expect-failure + "TokenMessage recipient is not a valid principal" + (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAZAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARncmVnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") +) \ No newline at end of file From 3d2a171bb83b1611695953de3858a013200da3db Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 11:04:33 -0800 Subject: [PATCH 04/20] TokenMessage recipient parsed as guard --- src/Pact/Native.hs | 25 ++++++++++++------------- tests/pact/hyperlane.repl | 19 ++++++++++++------- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index d89c82eef..59013d06c 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -77,7 +77,6 @@ import Data.Bits import Data.Decimal (Decimal) import Data.Default import Data.DoubleWord (Word128(..), Word256(..)) -import Data.Either (isRight) import Data.Functor(($>)) import Data.Foldable import Data.List (isPrefixOf) @@ -113,7 +112,6 @@ import Pact.Types.Hash import Pact.Types.Names import Pact.Types.PactValue import Pact.Types.Pretty hiding (list) -import Pact.Types.Principal (principalParser) import Pact.Types.Purity import Pact.Types.Runtime import Pact.Types.Version @@ -122,6 +120,7 @@ import Crypto.Hash.PoseidonNative (poseidon) import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) import qualified Pact.JSON.Encode as J +import qualified Pact.JSON.Decode as J -- | All production native modules. natives :: [NativeModule] @@ -1646,7 +1645,7 @@ hyperlaneDecodeTokenMessageDef = case B64URL.decode (T.encodeUtf8 msg) of Left _ -> evalError' i $ "Failed to base64-decode token message" Right bytes -> do - case runGetOrFail (getTokenMessageERC20 (getInfo i)) (BS.fromStrict bytes) of + case runGetOrFail getTokenMessageERC20 (BS.fromStrict bytes) of -- In case of Binary decoding failure, emit a terse error message. -- If the error message begins with TokenError, we know that we -- created it, and it is going to be stable (non-forking). @@ -1660,16 +1659,19 @@ hyperlaneDecodeTokenMessageDef = -- by parsing? -- TODO: Is this format correct? I.e. field names? Right (_,_,(amount, chain, recipient)) -> - pure $ toTObject TyAny def - [("recipient", TLiteral (LString recipient) def) - ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def) - ,("chainId", toTerm chain) - ] + case PGuard <$> J.eitherDecode (BS.fromStrict $ T.encodeUtf8 recipient) of + Left e -> evalError' i $ "Could not parse recipient into a guard: " <> pretty e + Right g -> + pure $ toTObject TyAny def + [("recipient", fromPactValue g) + ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def) + ,("chainId", toTerm chain) + ] _ -> argsError i args -- The TokenMessage contains a recipient (text) and an amount (word-256). - getTokenMessageERC20 :: Info -> Get (Word256, ChainId, Text) - getTokenMessageERC20 i = do + getTokenMessageERC20 :: Get (Word256, ChainId, Text) + getTokenMessageERC20 = do -- Parse the size of the following amount field. amountSize <- fromIntegral @Word256 @Int <$> getWord256be @@ -1681,9 +1683,6 @@ hyperlaneDecodeTokenMessageDef = recipientSize <- getWord256be tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize - unless (isRight (AP.parseOnly (principalParser i) tmRecipient)) $ - fail $ "TokenMessage recipient is not a valid principal." - return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient) where getWord256be = Word256 <$> getWord128be <*> getWord128be diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl index 69c3f5f6b..1b5a290fb 100644 --- a/tests/pact/hyperlane.repl +++ b/tests/pact/hyperlane.repl @@ -1,20 +1,25 @@ ;; Test hyperlane builtins. +(env-data + { "test-keys" : {"pred": "keys-all", "keys": ["da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6"]} + }) + (expect "computes the correct message id" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1})) ; Decoding a valid TokenMessage should succeed. (expect "decodes the correct TokenMessage" { "amount":0.000000000000000123, "chainId": "4", - "recipient": "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69" + "recipient": (read-keyset 'test-keys) } - (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") + (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") ) -; This TokenMessage was encoded with the recipient "greg". It should fail -; to decode because "greg" is not a valid principal. (Recipient must be a -; valid principal). +; This TokenMessage was encoded with the recipient +; "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69". +; It should fail to decode because "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69" +; is a principal, not a guard. (Recipient must be a guard encoded in json). (expect-failure - "TokenMessage recipient is not a valid principal" - (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAZAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARncmVnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") + "Decoding requires recipient to be a guard." + (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") ) \ No newline at end of file From b96ebc67ab672389bc9a53ee7b901d2eacbd315d Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 11:34:10 -0800 Subject: [PATCH 05/20] add new builtin to pact411natives and suppress a debugging error message --- src/Pact/Interpreter.hs | 2 +- src/Pact/Native.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs index 885a8ddfa..ecbf42560 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -276,7 +276,7 @@ pact410Natives :: [Text] pact410Natives = ["poseidon-hash-hack-a-chain"] pact411Natives :: [Text] -pact411Natives = ["enforce-verifier", "hyperlane-message-id"] +pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-tokenmessage"] initRefStore :: RefStore initRefStore = RefStore nativeDefs diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 59013d06c..d0666802b 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1660,7 +1660,7 @@ hyperlaneDecodeTokenMessageDef = -- TODO: Is this format correct? I.e. field names? Right (_,_,(amount, chain, recipient)) -> case PGuard <$> J.eitherDecode (BS.fromStrict $ T.encodeUtf8 recipient) of - Left e -> evalError' i $ "Could not parse recipient into a guard: " <> pretty e + Left _ -> evalError' i $ "Could not parse recipient into a guard" Right g -> pure $ toTObject TyAny def [("recipient", fromPactValue g) From bd9fb7b9d6759c89b73ad97551e9d7862b9bc000 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 11:40:44 -0800 Subject: [PATCH 06/20] exhaust the TokenMessage when parsing --- src/Pact/Native.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index d0666802b..9d4dc7af9 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -66,7 +66,7 @@ import Control.Monad import Control.Monad.IO.Class import qualified Data.Attoparsec.Text as AP import Data.Bifunctor (first) -import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString) +import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString, isEmpty) import Data.Binary.Put (Put, runPut, putWord64be, putByteString) import Data.Bool (bool) import qualified Data.ByteString as BS @@ -1643,9 +1643,9 @@ hyperlaneDecodeTokenMessageDef = -- TODO: standard alphabet, or URL? computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ case B64URL.decode (T.encodeUtf8 msg) of - Left _ -> evalError' i $ "Failed to base64-decode token message" + Left _ -> evalError' i "Failed to base64-decode token message" Right bytes -> do - case runGetOrFail getTokenMessageERC20 (BS.fromStrict bytes) of + case runGetOrFail (getTokenMessageERC20 <* eof) (BS.fromStrict bytes) of -- In case of Binary decoding failure, emit a terse error message. -- If the error message begins with TokenError, we know that we -- created it, and it is going to be stable (non-forking). @@ -1703,6 +1703,11 @@ hyperlaneDecodeTokenMessageDef = let ethInWei = 1000000000000000000 -- 1e18 in fromRational (toInteger w % ethInWei) + eof :: Get () + eof = do + done <- isEmpty + unless done $ fail "pending bytes in input" + -- | Helper function for creating TokenMessages encoded in the ERC20 format -- and base64url encoded. Used for generating test data. encodeTokenMessage :: BS.ByteString -> Word256 -> Word256 -> Text From 5d6c156b9af6796bc2bd329e661ed659d97064bf Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 13:07:28 -0800 Subject: [PATCH 07/20] use wide-word instead of doubleword --- pact.cabal | 1 - src/Pact/Native.hs | 15 ++++++--------- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/pact.cabal b/pact.cabal index 26dea73ef..881670980 100644 --- a/pact.cabal +++ b/pact.cabal @@ -221,7 +221,6 @@ library , deriving-compat >=0.5.1 , direct-sqlite >=2.3.27 , directory >=1.2.6.2 - , data-dword , errors >=2.3 , exceptions >=0.8.3 , filepath >=1.4.1.0 diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 9d4dc7af9..752eebbe1 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -66,8 +66,9 @@ import Control.Monad import Control.Monad.IO.Class import qualified Data.Attoparsec.Text as AP import Data.Bifunctor (first) -import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString, isEmpty) -import Data.Binary.Put (Put, runPut, putWord64be, putByteString) +import Data.Binary (get, put) +import Data.Binary.Get (Get, runGetOrFail, getByteString, isEmpty) +import Data.Binary.Put (Put, runPut, putByteString) import Data.Bool (bool) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 @@ -76,7 +77,6 @@ import qualified Data.Char as Char import Data.Bits import Data.Decimal (Decimal) import Data.Default -import Data.DoubleWord (Word128(..), Word256(..)) import Data.Functor(($>)) import Data.Foldable import Data.List (isPrefixOf) @@ -89,6 +89,7 @@ import Data.Text (Text, pack, unpack) import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Encoding as T +import Data.WideWord.Word256 import Pact.Time import qualified Data.Vector as V import qualified Data.Vector.Algorithms.Intro as V @@ -1685,8 +1686,7 @@ hyperlaneDecodeTokenMessageDef = return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient) where - getWord256be = Word256 <$> getWord128be <*> getWord128be - getWord128be = Word128 <$> getWord64be <*> getWord64be + getWord256be = get @Word256 -- TODO: We check the size. Is this ok? -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes. @@ -1723,10 +1723,7 @@ encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encode (BS.toS (recipientBytes, recipientSize) = padRight recipient putWord256be :: Word256 -> Put - putWord256be (Word256 x y) = putWord128be x >> putWord128be y - - putWord128be :: Word128 -> Put - putWord128be (Word128 x y) = putWord64be x >> putWord64be y + putWord256be = put @Word256 padRight :: BS.ByteString -> (BS.ByteString, Word256) padRight s = From e2b65c1198cc474b0736244c664142a292e3fb54 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 13:08:35 -0800 Subject: [PATCH 08/20] remove stale TODOs --- src/Pact/Native.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 752eebbe1..636b3775a 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1656,9 +1656,6 @@ hyperlaneDecodeTokenMessageDef = -- (TODO: Do we suppress error messages on-chain anyway?) Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e Left _ -> evalError' i "Decoding error: binary decoding failed" - -- TODO: Do we need to assert that the bytes are fully consumed - -- by parsing? - -- TODO: Is this format correct? I.e. field names? Right (_,_,(amount, chain, recipient)) -> case PGuard <$> J.eitherDecode (BS.fromStrict $ T.encodeUtf8 recipient) of Left _ -> evalError' i $ "Could not parse recipient into a guard" From 3631cb833ddac3c0de62800b8245b1a2468fc68b Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 13:09:27 -0800 Subject: [PATCH 09/20] cleanup more comments --- src/Pact/Native.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 636b3775a..644fd082c 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1637,11 +1637,10 @@ hyperlaneDecodeTokenMessageDef = [TLitString msg] -> -- We do not need to handle historical b64 error message shimming -- or decoding from non-canonical strings in this base-64 decoder, - -- because this native is added in a Pact version that latre than when + -- because this native is added in a Pact version that later than when -- we moved to base64-bytestring >= 1.0, which behaves succeeds and -- fails in exactly the cases we expect. -- (The only change we make to its output is to strip error messages). - -- TODO: standard alphabet, or URL? computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ case B64URL.decode (T.encodeUtf8 msg) of Left _ -> evalError' i "Failed to base64-decode token message" @@ -1653,7 +1652,6 @@ hyperlaneDecodeTokenMessageDef = -- If it does not start with TokenMessage, it may have come from -- the Binary library, and we will suppress it to shield ourselves -- from forking behavior if we update our Binary version. - -- (TODO: Do we suppress error messages on-chain anyway?) Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e Left _ -> evalError' i "Decoding error: binary decoding failed" Right (_,_,(amount, chain, recipient)) -> From 9601df13ddebe45ab3053b98d6d0a4c391453c2c Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 14:02:46 -0800 Subject: [PATCH 10/20] Set the empirically measured cas cost for TokenMessage decoding --- src/Pact/Gas/Table.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index cac82e70c..23beed352 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -84,7 +84,7 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50 , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38 , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47 - , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 1 -- TODO: Benchmark + , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 50 } defaultGasTable :: Map Text Gas From 68a1f5160691e30b745014017f2efedc35735da2 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 14:07:28 -0800 Subject: [PATCH 11/20] fix example in native definition --- src/Pact/Native.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 644fd082c..6bba8d960 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1628,8 +1628,8 @@ hyperlaneDecodeTokenMessageDef = "hyperlane-decode-tokenmessage" hyperlaneDecodeTokenMessageDef' (funType tTyObjectAny [("x", tTyString)]) - ["(TODO example)"] - "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:STRING, amount:DECIMAL, chainId:STRING}`." + ["(hyperlane-decode-tokenmessage \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\")"] + "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`." where hyperlaneDecodeTokenMessageDef' :: RNativeFun e hyperlaneDecodeTokenMessageDef' i args = case args of From 6e7086ac4fe73a8a4c4fb9628fb7cb0aa748bd17 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 14:17:28 -0800 Subject: [PATCH 12/20] fix examples --- docs/en/pact-functions.md | 26 +++++++++++++++++++------- tests/GasModelSpec.hs | 3 ++- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index f66236e7d..b8d3d5727 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -5,14 +5,14 @@ Constant denoting the ASCII charset -Constant: +Constant:   `CHARSET_ASCII:integer = 0` ### CHARSET_LATIN1 {#CHARSET_LATIN1} Constant denoting the Latin-1 charset ISO-8859-1 -Constant: +Constant:   `CHARSET_LATIN1:integer = 1` ### at {#at} @@ -765,7 +765,7 @@ Top level only: this function will fail if used in module code. Select rows from TABLE using QRY as a predicate with both key and value, and then accumulate results of the query in CONSUMER. Output is sorted by the ordering of keys. ```lisp -(let* +(let* ((qry (lambda (k obj) true)) ;; select all rows (f (lambda (k obj) [(at 'firstName obj), (at 'b obj)])) ) @@ -924,7 +924,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") 15) *n* `integer` *→* `decimal` -N days, for use with 'add-time' +N days, for use with 'add-time' ```lisp pact> (add-time (time "2016-07-22T12:00:00Z") (days 1)) "2016-07-23T12:00:00Z" @@ -962,7 +962,7 @@ pact> (format-time "%F" (time "2016-07-22T12:00:00Z")) *n* `integer` *→* `decimal` -N hours, for use with 'add-time' +N hours, for use with 'add-time' ```lisp pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1)) "2016-07-22T13:00:00Z" @@ -976,7 +976,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1)) *n* `integer` *→* `decimal` -N minutes, for use with 'add-time'. +N minutes, for use with 'add-time'. ```lisp pact> (add-time (time "2016-07-22T12:00:00Z") (minutes 1)) "2016-07-22T12:01:00Z" @@ -1000,7 +1000,7 @@ pact> (parse-time "%F" "2016-09-12") *utcval* `string` *→* `time` -Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ). +Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ). ```lisp pact> (time "2016-07-22T11:26:35Z") "2016-07-22T11:26:35Z" @@ -1817,6 +1817,18 @@ pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8) ## Hyperlane {#Hyperlane} +### hyperlane-decode-tokenmessage {#hyperlane-decode-tokenmessage} + +*x* `string` *→* `object:*` + + +Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`. +```lisp +pact> (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") +{"amount": 0.000000000000000123,"chainId": "4","recipient": KeySet {keys: [da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6],pred: keys-all}} +``` + + ### hyperlane-message-id {#hyperlane-message-id} *x* `object:*` *→* `string` diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index 184b91634..d0fa2070f 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -91,6 +91,7 @@ untestedNativesCheck = do , "dec" , "list" , "continue" + , "hyperlane-decode-tokenmessage" ]) allGasTestsAndGoldenShouldPass :: Spec @@ -144,7 +145,7 @@ allNativesInGasTable = do absentNatives = foldl' absent [] justNatives (S.fromList absentNatives) `shouldBe` - (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "public-chain-data", "list"]) + (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "hyperlane-decode-tokenmessage", "public-chain-data", "list"]) -- | Use this to run a single named test. _runNative :: NativeDefName -> IO (Maybe [(T.Text,Gas)]) From 89d10cac09e29e2ea51cb1ff3fd45d7e23de7c6a Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 21 Feb 2024 16:19:54 -0800 Subject: [PATCH 13/20] rename builtin to hyperlane-decode-token-message --- docs/en/pact-functions.md | 4 ++-- src/Pact/Interpreter.hs | 2 +- src/Pact/Native.hs | 4 ++-- src/Pact/Types/Gas.hs | 2 +- tests/GasModelSpec.hs | 4 ++-- tests/pact/hyperlane.repl | 4 ++-- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index b8d3d5727..963e6540d 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -1817,14 +1817,14 @@ pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8) ## Hyperlane {#Hyperlane} -### hyperlane-decode-tokenmessage {#hyperlane-decode-tokenmessage} +### hyperlane-decode-token-message {#hyperlane-decode-token-message} *x* `string` *→* `object:*` Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`. ```lisp -pact> (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") +pact> (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") {"amount": 0.000000000000000123,"chainId": "4","recipient": KeySet {keys: [da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6],pred: keys-all}} ``` diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs index ecbf42560..c7c035b23 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -276,7 +276,7 @@ pact410Natives :: [Text] pact410Natives = ["poseidon-hash-hack-a-chain"] pact411Natives :: [Text] -pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-tokenmessage"] +pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-token-message"] initRefStore :: RefStore initRefStore = RefStore nativeDefs diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 6bba8d960..e6a6c7b6d 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1625,10 +1625,10 @@ hyperlaneMessageIdDef = defGasRNative hyperlaneDecodeTokenMessageDef :: NativeDef hyperlaneDecodeTokenMessageDef = defGasRNative - "hyperlane-decode-tokenmessage" + "hyperlane-decode-token-message" hyperlaneDecodeTokenMessageDef' (funType tTyObjectAny [("x", tTyString)]) - ["(hyperlane-decode-tokenmessage \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\")"] + ["(hyperlane-decode-token-message \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\")"] "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`." where hyperlaneDecodeTokenMessageDef' :: RNativeFun e diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index df7325417..55c0643a8 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -187,7 +187,7 @@ data GasArgs -- hyperlane TokenMessage Recipient, which is the only variable-length -- part of a HyperlaneMessage | GHyperlaneDecodeTokenMessage !Int - -- ^ Cost of hyperlane-decode-tokenmessage on this size (in bytes) of the + -- ^ Cost of hyperlane-decode-token-message on this size (in bytes) of the -- hyperlane TokenMessage base64-encoded string. data IntOpThreshold diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index d0fa2070f..8d6eafcc2 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -91,7 +91,7 @@ untestedNativesCheck = do , "dec" , "list" , "continue" - , "hyperlane-decode-tokenmessage" + , "hyperlane-decode-token-message" ]) allGasTestsAndGoldenShouldPass :: Spec @@ -145,7 +145,7 @@ allNativesInGasTable = do absentNatives = foldl' absent [] justNatives (S.fromList absentNatives) `shouldBe` - (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "hyperlane-decode-tokenmessage", "public-chain-data", "list"]) + (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "hyperlane-decode-token-message", "public-chain-data", "list"]) -- | Use this to run a single named test. _runNative :: NativeDefName -> IO (Maybe [(T.Text,Gas)]) diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl index 1b5a290fb..20dc971ef 100644 --- a/tests/pact/hyperlane.repl +++ b/tests/pact/hyperlane.repl @@ -12,7 +12,7 @@ "chainId": "4", "recipient": (read-keyset 'test-keys) } - (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") + (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") ) ; This TokenMessage was encoded with the recipient @@ -21,5 +21,5 @@ ; is a principal, not a guard. (Recipient must be a guard encoded in json). (expect-failure "Decoding requires recipient to be a guard." - (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") + (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") ) \ No newline at end of file From f899c6023d428f745090410993fb27a58ee96863 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 09:07:05 -0800 Subject: [PATCH 14/20] use base64-unpadded encoding/decoding for tokenmessage --- src/Pact/Native.hs | 4 ++-- tests/pact/hyperlane.repl | 5 +++++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index e6a6c7b6d..cd1192a92 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1642,7 +1642,7 @@ hyperlaneDecodeTokenMessageDef = -- fails in exactly the cases we expect. -- (The only change we make to its output is to strip error messages). computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ - case B64URL.decode (T.encodeUtf8 msg) of + case B64URL.decodeUnpadded (T.encodeUtf8 msg) of Left _ -> evalError' i "Failed to base64-decode token message" Right bytes -> do case runGetOrFail (getTokenMessageERC20 <* eof) (BS.fromStrict bytes) of @@ -1706,7 +1706,7 @@ hyperlaneDecodeTokenMessageDef = -- | Helper function for creating TokenMessages encoded in the ERC20 format -- and base64url encoded. Used for generating test data. encodeTokenMessage :: BS.ByteString -> Word256 -> Word256 -> Text -encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encode (BS.toStrict bytes) +encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encodeUnpadded (BS.toStrict bytes) where bytes = runPut $ do putWord256be (96 :: Word256) diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl index 20dc971ef..bb5ffdb9e 100644 --- a/tests/pact/hyperlane.repl +++ b/tests/pact/hyperlane.repl @@ -12,6 +12,11 @@ "chainId": "4", "recipient": (read-keyset 'test-keys) } + (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") +) + +; Decoding a valid TokenMessage should succeed. +(expect-failure "decoding fails for base64-padded messages" (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") ) From 2e2703dc3d2bbeb5ad73f6b2bd95b6a84111bed1 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 09:57:19 -0800 Subject: [PATCH 15/20] fix gas costing and add gas tests --- src/Pact/Gas/Table.hs | 1 + src/Pact/Native.hs | 3 +-- tests/pact/hyperlane.repl | 14 +++++++++++++- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 23beed352..8c1451d5f 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -241,6 +241,7 @@ defaultGasTable = ,("poseidon-hash-hack-a-chain", 124) ,("hyperlane-message-id", 2) + ,("hyperlane-decode-token-message", 2) ] {-# NOINLINE defaultGasTable #-} diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index cd1192a92..21c039ed8 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1683,7 +1683,6 @@ hyperlaneDecodeTokenMessageDef = where getWord256be = get @Word256 - -- TODO: We check the size. Is this ok? -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes. getRecipient :: Word256 -> Get BS.ByteString getRecipient size = do @@ -1729,4 +1728,4 @@ padRight s = -- | Returns the modular of 32 bytes. restSize :: Integral a => a -> a -restSize size = (32 - size) `mod` 32 \ No newline at end of file +restSize size = (32 - size) `mod` 32 diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl index bb5ffdb9e..90e8bd781 100644 --- a/tests/pact/hyperlane.repl +++ b/tests/pact/hyperlane.repl @@ -27,4 +27,16 @@ (expect-failure "Decoding requires recipient to be a guard." (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=") -) \ No newline at end of file +) + +; Gas tests. +(env-gasmodel "table") +(env-gaslimit 10000) + +(env-gas) +(hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") +(expect "Normal message decoding should cost 2 gas" 2 (env-gas)) + +(env-gas 0) +(hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABfwgIHsgInByZWQiOiAia2V5cy1hbnkiLCAia2V5cyI6IFsgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiIF0gfQAAAAA") +(expect "Decoding a message with about 2000 characters should cost 3 gas" 3 (env-gas)) From 091c68f4e10845c5487f3209a75bcbfdce997f6c Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 10:00:24 -0800 Subject: [PATCH 16/20] lower bound for binary dependency --- pact.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pact.cabal b/pact.cabal index 881670980..82bd8163a 100644 --- a/pact.cabal +++ b/pact.cabal @@ -207,7 +207,7 @@ library , base >= 4.18.0.0 , base16-bytestring >=0.1.1.6 , base64-bytestring >=1.0.0.1 - , binary + , binary >=0.8.9.1 -- base64-bytestring >=1.2.0.0 is less lenient then previous versions, which can cause pact failures (e.g. (env-hash "aa")) , bound >=2 , bytestring >=0.10.8.1 From 3a61688d32942e1d28219ebecffe8eb582ee75fb Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 10:05:37 -0800 Subject: [PATCH 17/20] cleanup tokenmessage decoder comments and variable names --- src/Pact/Native.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 21c039ed8..9b1b4eff3 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1666,13 +1666,20 @@ hyperlaneDecodeTokenMessageDef = _ -> argsError i args -- The TokenMessage contains a recipient (text) and an amount (word-256). + -- A schematic of the message format: + -- 0000000000000000000000000000000000000000000000000000000000000060 # offset of the recipient string = 96, because first three lines are 32 bytes each + -- 0000000000000000000000000000000000000000000000008ac7230489e80000 # amount = 10000000000000000000 + -- 0000000000000000000000000000000000000000000000000000000000000000 # chainId = 0 + -- 000000000000000000000000000000000000000000000000000000000000002a # recipientSize = 42 + -- 3078373143373635364543376162383862303938646566423735314237343031 # "0x71C7656EC7ab88b098defB751B7401B5f6d8976F" + -- 4235663664383937364600000000000000000000000000000000000000000000 getTokenMessageERC20 :: Get (Word256, ChainId, Text) getTokenMessageERC20 = do -- Parse the size of the following amount field. - amountSize <- fromIntegral @Word256 @Int <$> getWord256be - unless (amountSize == 96) - (fail $ "TokenMessage amountSize expected 96, found " ++ show amountSize) + firstOffset <- fromIntegral @Word256 @Int <$> getWord256be + unless (firstOffset == 96) + (fail $ "TokenMessage firstOffset expected 96, found " ++ show firstOffset) tmAmount <- getWord256be tmChainId <- getWord256be From 16f278cc756c4e719231793b989182e1d5cb3fa1 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 10:08:37 -0800 Subject: [PATCH 18/20] remove padding from encoded message in tokenmessage decoding example --- src/Pact/Native.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 9b1b4eff3..2b346738e 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1628,8 +1628,8 @@ hyperlaneDecodeTokenMessageDef = "hyperlane-decode-token-message" hyperlaneDecodeTokenMessageDef' (funType tTyObjectAny [("x", tTyString)]) - ["(hyperlane-decode-token-message \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\")"] - "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`." + ["(hyperlane-decode-token-message \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\")"] + "Decode a base-64-unpadded encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`." where hyperlaneDecodeTokenMessageDef' :: RNativeFun e hyperlaneDecodeTokenMessageDef' i args = case args of From 4e7f70f7e1f6e095e9753312738103af3b804f6e Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 10:36:46 -0800 Subject: [PATCH 19/20] gasmodelspec remove buildin from list of gas-untested --- tests/GasModelSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index 8d6eafcc2..cbfc67953 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -145,7 +145,7 @@ allNativesInGasTable = do absentNatives = foldl' absent [] justNatives (S.fromList absentNatives) `shouldBe` - (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "hyperlane-decode-token-message", "public-chain-data", "list"]) + (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "public-chain-data", "list"]) -- | Use this to run a single named test. _runNative :: NativeDefName -> IO (Maybe [(T.Text,Gas)]) From bd6d3cb344ef630279a8bdf57f83e92efd91d2fa Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 22 Feb 2024 12:36:18 -0800 Subject: [PATCH 20/20] update example encoding --- src/Pact/Native.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 2b346738e..5eb69ed4d 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1670,9 +1670,11 @@ hyperlaneDecodeTokenMessageDef = -- 0000000000000000000000000000000000000000000000000000000000000060 # offset of the recipient string = 96, because first three lines are 32 bytes each -- 0000000000000000000000000000000000000000000000008ac7230489e80000 # amount = 10000000000000000000 -- 0000000000000000000000000000000000000000000000000000000000000000 # chainId = 0 - -- 000000000000000000000000000000000000000000000000000000000000002a # recipientSize = 42 - -- 3078373143373635364543376162383862303938646566423735314237343031 # "0x71C7656EC7ab88b098defB751B7401B5f6d8976F" - -- 4235663664383937364600000000000000000000000000000000000000000000 + -- 0000000000000000000000000000000000000000000000000000000000000062 # recipientSize = 98 + -- 7B2270726564223A20226B6579732D616C6C222C20226B657973223A205B2264 # {"pred": "keys-all", "keys": ["da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6"]} + -- 6131613333396264383264326332653931383036323661303064633034333237 + -- 3564656233616261626232376235373338616266366239646365653864623622 + -- 5D7D getTokenMessageERC20 :: Get (Word256, ChainId, Text) getTokenMessageERC20 = do