diff --git a/.gitignore b/.gitignore index 2db79ee6e..c7c62e705 100644 --- a/.gitignore +++ b/.gitignore @@ -36,3 +36,5 @@ cabal.project.local* /golden/lcov/actual .DS_Store .ghci_history +.direnv/ +.envrc diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index 9dac53523..61f2b8b12 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -1878,6 +1878,17 @@ pact> (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA {"amount": 0.000000000000000123,"chainId": "4","recipient": KeySet {keys: [da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6],pred: keys-all}} ``` +### hyperlane-encode-token-message {#hyperlane-encode-token-message} + +*x* `object:*` *→* `string` + + +Encode an Hyperlane Token Message object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}` into a base-64-unpadded string. +```lisp +pact> (hyperlane-encode-token-message {"amount": 599.0,"chainId": "1","recipient": "{\"pred\": \"keys-all\", \"keys\":[\"da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6\"]}"}) +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACB4y35cqvwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +``` + ### hyperlane-message-id {#hyperlane-message-id} @@ -1886,8 +1897,8 @@ pact> (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA Get the Message Id of a Hyperlane Message object. ```lisp -pact> (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1}) -"0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" +pact> (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1}) +"0x3cbd30e222a483f3ad52191674b2f6951adb88636553d10f69a4a002ffd6c8d4" ``` ## REPL-only functions {#repl-lib} diff --git a/golden/gas-model/golden b/golden/gas-model/golden index 105c07231..0a6f882ce 100644 --- a/golden/gas-model/golden +++ b/golden/gas-model/golden @@ -611,8 +611,8 @@ "77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a") - 29 - - |- - (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1}) - (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"},"version": 1}) + (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1}) + (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1}) - 4 - - (^ 2 longNumber) - 4 diff --git a/pact.cabal b/pact.cabal index 84b61c365..36c8b0f16 100644 --- a/pact.cabal +++ b/pact.cabal @@ -97,7 +97,7 @@ library exposed-modules: Crypto.Hash.Blake2Native Crypto.Hash.Keccak256Native - Crypto.Hash.HyperlaneMessageId + Crypto.Hash.HyperlaneNatives Crypto.Hash.PoseidonNative Pact.Analyze.Remote.Types Pact.ApiReq @@ -424,6 +424,7 @@ test-suite hspec , base , base16-bytestring , base64-bytestring + , binary , bound , bytestring , containers @@ -443,6 +444,7 @@ test-suite hspec , trifecta , unordered-containers , vector + , wide-word >= 0.1 other-modules: Blake2Spec diff --git a/src/Crypto/Hash/HyperlaneMessageId.hs b/src/Crypto/Hash/HyperlaneMessageId.hs deleted file mode 100644 index 0685a2096..000000000 --- a/src/Crypto/Hash/HyperlaneMessageId.hs +++ /dev/null @@ -1,170 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} - --- | Implementation of the `hyperlane-message-id` pact native. --- --- `hyperlane-message-id` takes as input a Pact object representing a --- 'HyperlaneMessage', and returns a base16-encoded hash of the abi-encoding --- of the input. -module Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) where - -import Control.Error.Util (hush) -import Control.Lens ((^?), at, _Just, Prism', _1) -import Data.ByteString (ByteString) -import Data.ByteString qualified as BS -import Data.ByteString.Base16 qualified as Base16 -import Data.ByteString.Builder (Builder) -import Data.ByteString.Builder qualified as BB -import Data.ByteString.Lazy qualified as BL -import Data.ByteString.Short qualified as BSS -import Data.Decimal (Decimal) -import Data.Map (Map) -import Data.Text (Text) -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text -import Data.WideWord.Word256 (Word256(..)) -import Data.Word (Word8, Word32) -import Ethereum.Misc (keccak256, _getKeccak256Hash, _getBytesN) -import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Literal, _TLiteral, _TObject, _LDecimal, _LInteger, _LString) -import Pact.Types.Term (Term) - ----------------------------------------------- --- Primitive -- ----------------------------------------------- - -hyperlaneMessageId :: Object Name -> Text -hyperlaneMessageId o = case decodeHyperlaneMessageObject o of - Nothing -> error "Couldn't decode HyperlaneMessage" - Just hm -> getHyperlaneMessageId hm - ----------------------------------------------- --- Hyperlane Message Encoding -- ----------------------------------------------- - -data HyperlaneMessage = HyperlaneMessage - { hmVersion :: Word8 -- uint8 - , hmNonce :: Word32 -- uint32 - , hmOriginDomain :: Word32 -- uint32 - , hmSender :: ByteString -- 32x uint8 - , hmDestinationDomain :: Word32 -- uint32 - , hmRecipient :: ByteString -- 32x uint8 - , hmTokenMessage :: TokenMessageERC20 -- variable - } - -packHyperlaneMessage :: HyperlaneMessage -> Builder -packHyperlaneMessage (HyperlaneMessage{..}) = - BB.word8 hmVersion - <> BB.word32BE hmNonce - <> BB.word32BE hmOriginDomain - <> BB.byteString (padLeft hmSender) - <> BB.word32BE hmDestinationDomain - <> BB.byteString (padLeft hmRecipient) - <> packTokenMessageERC20 hmTokenMessage - -data TokenMessageERC20 = TokenMessageERC20 - { tmRecipient :: Text -- variable - , tmAmount :: Word256 -- uint256 - , tmChainId :: Maybe Word256 -- uint256 - } - -packTokenMessageERC20 :: TokenMessageERC20 -> Builder -packTokenMessageERC20 t = - word256BE 64 - <> word256BE (tmAmount t) - - <> word256BE recipientSize - <> BB.byteString recipient - where - (recipient, recipientSize) = padRight (Text.encodeUtf8 (tmRecipient t)) - -word256BE :: Word256 -> Builder -word256BE (Word256 a b c d) = - BB.word64BE a <> BB.word64BE b <> BB.word64BE c <> BB.word64BE d - --- | Pad with zeroes on the left to 32 bytes --- --- > padLeft "hello world" --- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NULhello world" -padLeft :: ByteString -> ByteString -padLeft s = BS.replicate (32 - BS.length s) 0 <> s - --- | Pad with zeroes on the right, such that the resulting size is a multiple of 32. --- --- > padRight "hello world" --- ("hello world\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL",11) -padRight :: ByteString -> (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 - ----------------------------------------------- --- Hyperlane Message Hashing -- ----------------------------------------------- - -getHyperlaneMessageId :: HyperlaneMessage -> Text -getHyperlaneMessageId = - encodeHex - . keccak256Hash - . BL.toStrict - . BB.toLazyByteString - . packHyperlaneMessage - -keccak256Hash :: ByteString -> ByteString -keccak256Hash = BSS.fromShort . _getBytesN . _getKeccak256Hash . keccak256 - -encodeHex :: ByteString -> Text -encodeHex b = "0x" <> Text.decodeUtf8 (Base16.encode b) - -decodeHex :: Text -> Maybe ByteString -decodeHex s = do - h <- Text.stripPrefix "0x" s - hush (Base16.decode (Text.encodeUtf8 h)) - ----------------------------------------------- --- Hyperlane Pact Object Decoding -- ----------------------------------------------- - -decodeHyperlaneMessageObject :: Object Name -> Maybe HyperlaneMessage -decodeHyperlaneMessageObject o = do - let om = _objectMap (_oObject o) - - hmVersion <- fromIntegral @Integer @Word8 <$> grabField om "version" _LInteger - hmNonce <- fromIntegral @Integer @Word32 <$> grabField om "nonce" _LInteger - hmOriginDomain <- fromIntegral @Integer @Word32 <$> grabField om "originDomain" _LInteger - hmSender <- Text.encodeUtf8 <$> grabField om "sender" _LString - hmDestinationDomain <- fromIntegral @Integer @Word32 <$> grabField om "destinationDomain" _LInteger - hmRecipient <- decodeHex =<< grabField om "recipient" _LString - - let tokenObject = om ^? at "tokenMessage" . _Just . _TObject . _1 - hmTokenMessage <- case decodeTokenMessageERC20 =<< tokenObject of - Just t -> pure t - _ -> error "Couldn't encode TokenMessageERC20" - - pure HyperlaneMessage{..} - -decodeTokenMessageERC20 :: Object Name -> Maybe TokenMessageERC20 -decodeTokenMessageERC20 o = do - let om = _objectMap (_oObject o) - tmRecipient <- grabField om "recipient" _LString - tmAmount <- decimalToWord <$> grabField om "amount" _LDecimal - let tmChainId = Nothing - pure $ TokenMessageERC20{..} - -decimalToWord :: Decimal -> Word256 -decimalToWord d = - let ethInWei = 1_000_000_000_000_000_000 -- 1e18 - in round $ d * ethInWei - -grabField :: Map FieldKey (Term Name) -> FieldKey -> Prism' Literal a -> Maybe a -grabField m key p = m ^? at key . _Just . _TLiteral . _1 . p diff --git a/src/Crypto/Hash/HyperlaneNatives.hs b/src/Crypto/Hash/HyperlaneNatives.hs new file mode 100644 index 000000000..ba3dfae23 --- /dev/null +++ b/src/Crypto/Hash/HyperlaneNatives.hs @@ -0,0 +1,379 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +-- | Implementation of Hyperlane natives. +module Crypto.Hash.HyperlaneNatives + ( HyperlaneMessage(..) + , TokenMessageERC20(..) + , decodeHyperlaneMessageObject + , packHyperlaneMessage + , packTokenMessageERC20 + , unpackTokenMessageERC20 + , tokenMessageToTerm + + -- Implementation of natives + , hyperlaneMessageId + , hyperlaneDecodeTokenMessage + , hyperlaneEncodeTokenMessage + ) where + +import Control.Lens ((^?), at, _Just, Prism', _1) +import Control.Monad (unless) +import Control.Monad.Except (throwError) +import Data.Bifunctor (first) +import Data.Binary.Get (Get) +import Data.Binary.Get qualified as Bin +import Data.Binary.Put qualified as Bin +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Builder (Builder) +import Data.ByteString.Builder qualified as BB +import Data.ByteString.Lazy qualified as BL +import Data.ByteString.Short qualified as BSS +import Data.Decimal (Decimal) +import Data.Default (def) +import Data.List qualified as List +import Data.Map (Map) +import Data.Ratio ((%)) +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Text.Read qualified as Text +import Data.WideWord.Word256 (Word256(..)) +import Data.Word (Word8, Word16, Word32) +import Ethereum.Misc (keccak256, _getKeccak256Hash, _getBytesN) +import Pact.JSON.Decode qualified as J +import Pact.Types.Exp (Literal(..)) +import Pact.Types.PactValue (PactValue(PGuard), fromPactValue) +import Pact.Types.Pretty (Doc, pretty) +import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Type(TyAny), _TLiteral, _LInteger, _LString, toTObject, ChainId(..), _LDecimal) +import Pact.Types.Term (Term(..), toTerm) +import Pact.Types.Util (decodeBase64UrlUnpadded, encodeBase64UrlUnpadded) + +---------------------------------------------- +-- Primitives -- +---------------------------------------------- + +hyperlaneMessageId :: Object Name -> Either Doc Text +hyperlaneMessageId o = do + hm <- first displayHyperlaneError $ decodeHyperlaneMessageObject o + pure $ getHyperlaneMessageId hm + +-- | Decode a hyperlane 'TokenMessageERC20' +hyperlaneDecodeTokenMessage :: Text -> Either Doc (Term Name) +hyperlaneDecodeTokenMessage i = do + tm <- first displayHyperlaneDecodeError $ do + -- 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 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). + bytes <- first (const HyperlaneDecodeErrorBase64) $ decodeBase64UrlUnpadded (Text.encodeUtf8 i) + case Bin.runGetOrFail (unpackTokenMessageERC20 <* eof) (BL.fromStrict bytes) of + Left (_, _, e) | "TokenMessage" `List.isPrefixOf` e -> do + throwError $ HyperlaneDecodeErrorInternal e + Left _ -> do + throwError HyperlaneDecodeErrorBinary + Right (_, _, tm) -> do + pure tm + tokenMessageToTerm tm + +hyperlaneEncodeTokenMessage :: Object Name -> Either Doc Text +hyperlaneEncodeTokenMessage o = do + tm <- first displayHyperlaneError $ decodeHyperlaneTokenMessageObject o + let encoded = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ BL.toStrict $ Bin.runPut $ Bin.putBuilder $ packTokenMessageERC20 tm + return encoded + +---------------------------------------------- +-- Error Types -- +---------------------------------------------- + +data HyperlaneError + = HyperlaneErrorFailedToFindKey FieldKey + -- ^ An expected key was not found. + | HyperlaneErrorNumberOutOfBounds FieldKey + -- ^ The number at this field was outside of the expected bounds of its + -- type. + | HyperlaneErrorBadHexPrefix FieldKey + -- ^ Hex textual fields (usually ETH addresses) must be prefixed with "0x" + | HyperlaneErrorInvalidBase64 FieldKey + -- ^ Invalid base64 text field. + | HyperlaneErrorIncorrectSize FieldKey Int Int + -- ^ Invalid Hex. We discard error messages from base16-bytestring to + | HyperlaneErrorInvalidChainId Text + +displayHyperlaneError :: HyperlaneError -> Doc +displayHyperlaneError = \case + HyperlaneErrorFailedToFindKey key -> "Failed to find key in object: " <> pretty key + HyperlaneErrorNumberOutOfBounds key -> "Object key " <> pretty key <> " was out of bounds" + HyperlaneErrorBadHexPrefix key -> "Missing 0x prefix on field " <> pretty key + HyperlaneErrorInvalidBase64 key -> "Invalid base64 encoding on field " <> pretty key + HyperlaneErrorIncorrectSize key expected actual -> + "Incorrect binary data size " <> pretty key <> ". Expected: " <> pretty expected <> ", but got " <> pretty actual + HyperlaneErrorInvalidChainId msg -> "Failed to decode chainId: " <> pretty msg + +data HyperlaneDecodeError + = HyperlaneDecodeErrorBase64 + -- ^ We discard the error message in this case to maintain error message + -- equality with the original implementation - otherwise this would have a + -- string in it + | HyperlaneDecodeErrorInternal String + -- ^ Decoding error that our own code threw, not `binary` + | HyperlaneDecodeErrorBinary + -- ^ We encountered an error not thrown by us but by `binary`. We discard + -- the error message to avoid potentially forking behaviour introduced + -- by a library update. + | HyperlaneDecodeErrorParseRecipient + -- ^ Failed to parse the Recipient into a Guard + +displayHyperlaneDecodeError :: HyperlaneDecodeError -> Doc +displayHyperlaneDecodeError = \case + HyperlaneDecodeErrorBase64 -> "Failed to base64-decode token message" + HyperlaneDecodeErrorInternal errmsg -> "Decoding error: " <> pretty errmsg + HyperlaneDecodeErrorBinary -> "Decoding error: binary decoding failed" + HyperlaneDecodeErrorParseRecipient -> "Could not parse recipient into a guard" + +---------------------------------------------- +-- Hyperlane Message Types -- +---------------------------------------------- + +data HyperlaneMessage = HyperlaneMessage + { hmVersion :: Word8 -- uint8 + , hmNonce :: Word32 -- uint32 + , hmOriginDomain :: Word32 -- uint32 + , hmSender :: ByteString -- 32x uint8 + , hmDestinationDomain :: Word32 -- uint32 + , hmRecipient :: ByteString -- 32x uint8 + , hmMessageBody :: ByteString -- variable + } + deriving stock (Eq, Show) + +data TokenMessageERC20 = TokenMessageERC20 + { tmAmount :: Word256 -- uint256 + , tmChainId :: Word16 -- uint16 + , tmRecipient :: ByteString -- variable + } + deriving stock (Eq, Show) + +---------------------------------------------- +-- Hyperlane Message Binary Encoding -- +---------------------------------------------- + +packHyperlaneMessage :: HyperlaneMessage -> Builder +packHyperlaneMessage (HyperlaneMessage{..}) = + BB.word8 hmVersion + <> BB.word32BE hmNonce + <> BB.word32BE hmOriginDomain + <> BB.byteString hmSender + <> BB.word32BE hmDestinationDomain + <> BB.byteString hmRecipient + <> BB.byteString hmMessageBody + +-- types shorter than 32 bytes are concatenated directly, without padding or sign extension +-- dynamic types are encoded in-place and without the length. +-- array elements are padded, but still encoded in-place + +{- + function formatMessage( + uint8 _version, + uint32 _nonce, + uint32 _originDomain, + bytes32 _sender, + uint32 _destinationDomain, + bytes32 _recipient, + bytes calldata _messageBody + ) internal pure returns (bytes memory) { + return + abi.encodePacked( + _version, + _nonce, + _originDomain, + _sender, + _destinationDomain, + _recipient, + _messageBody + ); + } +-} + +-- The TokenMessage contains a recipient (text) and an amount (word-256). +-- A schematic of the message format: +-- 0000000000000000000000000000000000000000000000008ac7230489e80000 # amount = 10000000000000000000 +-- 0000000000000000000000000000000000000000000000000000000000000000 # chainId = 0 +-- 7B2270726564223A20226B6579732D616C6C222C20226B657973223A205B2264 # {"pred": "keys-all", "keys": ["da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6"]} +-- 6131613333396264383264326332653931383036323661303064633034333237 +-- 3564656233616261626232376235373338616266366239646365653864623622 +-- 5D7D +packTokenMessageERC20 :: TokenMessageERC20 -> Builder +packTokenMessageERC20 t = + word256BE (tmAmount t) + <> BB.word16BE (tmChainId t) + <> BB.byteString (tmRecipient t) + +unpackTokenMessageERC20 :: Get TokenMessageERC20 +unpackTokenMessageERC20 = do + tmAmount <- getWord256BE + tmChainId <- Bin.getWord16be + tmRecipient <- BL.toStrict <$> Bin.getRemainingLazyByteString + + pure $ TokenMessageERC20 {..} + +---------------------------------------------- +-- Hyperlane Message Hashing -- +---------------------------------------------- + +getHyperlaneMessageId :: HyperlaneMessage -> Text +getHyperlaneMessageId = + Text.decodeUtf8 + . encodeBase64UrlUnpadded + . keccak256Hash + . BL.toStrict + . BB.toLazyByteString + . packHyperlaneMessage + +keccak256Hash :: ByteString -> ByteString +keccak256Hash = BSS.fromShort . _getBytesN . _getKeccak256Hash . keccak256 + +decodeBase64 :: FieldKey -> Text -> Either HyperlaneError ByteString +decodeBase64 key s = + first (const (HyperlaneErrorInvalidBase64 key)) $ decodeBase64UrlUnpadded $ Text.encodeUtf8 s + +decodeBase64AndValidate :: FieldKey -> Int -> Text -> Either HyperlaneError ByteString +decodeBase64AndValidate key expected s = do + decoded <- decodeBase64 key s + + unless (BS.length decoded == expected) $ + throwError $ HyperlaneErrorIncorrectSize key expected (BS.length decoded) + + return decoded + +parseChainId :: forall a. (a ~ Word16) => Text -> Either HyperlaneError a +parseChainId s = do + (cid, _) <- first (HyperlaneErrorInvalidChainId . Text.pack) $ Text.decimal s + unless (cid >= minBound && cid <= maxBound) $ do + throwError $ HyperlaneErrorInvalidChainId $ Text.pack $ + "ChainId must be in [" <> show @a minBound <> ", " <> show @a maxBound <> "]" + pure cid + +------------------------------------------------------ +-- Hyperlane Message Pact Object Decoding -- +------------------------------------------------------ + +decodeHyperlaneMessageObject :: Object Name -> Either HyperlaneError HyperlaneMessage +decodeHyperlaneMessageObject o = do + let om = _objectMap (_oObject o) + + hmVersion <- grabInt @Word8 om "version" + hmNonce <- grabInt @Word32 om "nonce" + hmOriginDomain <- grabInt @Word32 om "originDomain" + hmSender <- decodeBase64AndValidate "sender" 32 =<< grabField om "sender" _LString + hmDestinationDomain <- grabInt @Word32 om "destinationDomain" + hmRecipient <- decodeBase64AndValidate "recipient" 32 =<< grabField om "recipient" _LString + hmMessageBody <- decodeBase64 "messageBody" =<< grabField om "messageBody" _LString + + pure HyperlaneMessage{..} + +------------------------------------------------------------ +-- Hyperlane Token Message Pact Object Decoding -- +------------------------------------------------------------ + +-- | Decodes Pact's object that represents a token message. +-- +-- Important: the token message object here represents the message +-- we are sending to the hyperlane, which is different from the one +-- we recieve. +-- +-- We are using the same ADT 'TokenMessageERC20', but the content +-- a bit different. Note 'decimalToWord' is not using 'ethInWei'. +-- This is because the necessary alighnment is done on the chain — +-- since we use a different set of tokens that with different +-- precisions (e.g. USDC with precision 6). +decodeHyperlaneTokenMessageObject :: Object Name -> Either HyperlaneError TokenMessageERC20 +decodeHyperlaneTokenMessageObject o = do + let om = _objectMap (_oObject o) + + tmRecipient <- decodeBase64 "recipient" =<< grabField om "recipient" _LString + tmAmount <- decimalToWord <$> grabField om "amount" _LDecimal + tmChainId <- parseChainId =<< grabField om "chainId" _LString + + pure TokenMessageERC20{..} + +---------------------------------------------- +-- Utilities -- +---------------------------------------------- + +wordToDecimal :: Word256 -> Decimal +wordToDecimal w = fromRational (toInteger w % ethInWei) + +decimalToWord :: Decimal -> Word256 +decimalToWord = round -- we don't multiply by ethInWei here as the data on chain is already correct + +ethInWei :: Num a => a +ethInWei = 1_000_000_000_000_000_000 -- 1e18 +{-# inline ethInWei #-} + +grabField :: Map FieldKey (Term Name) -> FieldKey -> Prism' Literal a -> Either HyperlaneError a +grabField m key p = case m ^? at key . _Just . _TLiteral . _1 . p of + Nothing -> Left (HyperlaneErrorFailedToFindKey key) + Just a -> Right a + +-- | Grab a bounded integral value out of the pact object, and make sure +-- the integer received is a valid element of that type +grabInt :: forall a. (Integral a, Bounded a) => Map FieldKey (Term Name) -> FieldKey -> Either HyperlaneError a +grabInt m key = do + i <- grabField m key _LInteger + if i >= fromIntegral @a @Integer minBound && i <= fromIntegral @a @Integer maxBound + then do + pure (fromIntegral @Integer @a i) + else do + throwError (HyperlaneErrorNumberOutOfBounds key) + +eof :: Get () +eof = do + done <- Bin.isEmpty + unless done $ fail "pending bytes in input" + +word256BE :: Word256 -> Builder +word256BE (Word256 a b c d) = + BB.word64BE a <> BB.word64BE b <> BB.word64BE c <> BB.word64BE d + +getWord256BE :: Get Word256 +getWord256BE = do + Word256 <$> Bin.getWord64be <*> Bin.getWord64be <*> Bin.getWord64be <*> Bin.getWord64be + +-- | Pad with zeroes on the right, such that the resulting size is a multiple of 32. +-- +-- > padRight "hello world" +-- ("hello world\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL",11) +_padRight :: ByteString -> (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 + +tokenMessageToTerm :: TokenMessageERC20 -> Either Doc (Term Name) +tokenMessageToTerm tm = first displayHyperlaneDecodeError $ do + g <- first (const HyperlaneDecodeErrorParseRecipient) + $ fmap PGuard + $ J.eitherDecode (BL.fromStrict (tmRecipient tm)) + let chainId = ChainId { _chainId = Text.pack (show (toInteger (tmChainId tm))) } + pure $ toTObject TyAny def + [ ("recipient", fromPactValue g) + , ("amount", TLiteral (LDecimal (wordToDecimal (tmAmount tm))) def) + , ("chainId", toTerm chainId) + ] diff --git a/src/Crypto/Hash/Keccak256Native.hs b/src/Crypto/Hash/Keccak256Native.hs index 34d78f486..74ac2a236 100644 --- a/src/Crypto/Hash/Keccak256Native.hs +++ b/src/Crypto/Hash/Keccak256Native.hs @@ -8,10 +8,6 @@ {-# LANGUAGE TypeApplications #-} -- | Implementation of the `keccak256` pact native. --- --- `keccak256` takes as input a Pact object representing a --- 'HyperlaneMessage', and returns a base16-encoded hash of the abi-encoding --- of the input. module Crypto.Hash.Keccak256Native (Keccak256Error(..), keccak256) where import Control.Exception (Exception(..), SomeException(..), try) diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 21f557062..953ad098f 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -58,6 +58,7 @@ data GasCostConfig = GasCostConfig , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes :: MilliGas + , _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes :: MilliGas , _gasCostConfig_keccak256GasPerOneHundredBytes :: MilliGas , _gasCostConfig_keccak256GasPerChunk :: MilliGas } @@ -88,6 +89,7 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38 , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47 , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 50 + , _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes = MilliGas 50 , _gasCostConfig_keccak256GasPerOneHundredBytes = MilliGas 146 , _gasCostConfig_keccak256GasPerChunk = MilliGas 2_120 } @@ -248,6 +250,7 @@ defaultGasTable = ,("hash-poseidon", 124) ,("hyperlane-message-id", 2) ,("hyperlane-decode-token-message", 2) + ,("hyperlane-encode-token-message", 2) ,("hash-keccak256",1) ] @@ -352,6 +355,9 @@ tableGasModel gasConfig = GHyperlaneDecodeTokenMessage len -> let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes gasConfig in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100) + GHyperlaneEncodeTokenMessage len -> + let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes gasConfig + in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100) GKeccak256 chunkBytes -> let MilliGas costPerOneHundredBytes = _gasCostConfig_keccak256GasPerOneHundredBytes gasConfig MilliGas costPerChunk = _gasCostConfig_keccak256GasPerChunk gasConfig diff --git a/src/Pact/GasModel/GasTests.hs b/src/Pact/GasModel/GasTests.hs index d5e52d1f9..3e6e2cfe0 100644 --- a/src/Pact/GasModel/GasTests.hs +++ b/src/Pact/GasModel/GasTests.hs @@ -2045,8 +2045,7 @@ hyperlaneMessageIdTests :: NativeDefName -> GasUnitTests hyperlaneMessageIdTests = defGasUnitTest $ PactExpression hyperlaneMessageIdExprText Nothing where hyperlaneMessageIdExprText = [text| - (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1}) - (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"},"version": 1}) + (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1}) |] keccak256Tests :: NativeDefName -> GasUnitTests diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs index 61cce1724..696ec4a2f 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -283,7 +283,7 @@ pact411Natives :: [Text] pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-token-message"] pact412Natives :: [Text] -pact412Natives = ["hash-keccak256", "hash-poseidon"] +pact412Natives = ["hash-keccak256", "hash-poseidon", "hyperlane-encode-token-message"] initRefStore :: RefStore initRefStore = RefStore nativeDefs diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 9b4aea7eb..2c6244d37 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -56,7 +56,6 @@ module Pact.Native , describeNamespaceSchema , dnUserGuard, dnAdminGuard, dnNamespaceName , cdPrevBlockHash - , encodeTokenMessage ) where import Control.Arrow hiding (app, first) @@ -66,30 +65,22 @@ import Control.Monad import Control.Monad.IO.Class import qualified Data.Attoparsec.Text as AP import Data.Bifunctor (first) -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 -import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.Char as Char import Data.Bits -import Data.Decimal (Decimal) import Data.Default 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) -import Data.Ratio ((%)) import qualified Data.Set as S 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 @@ -119,10 +110,9 @@ import Pact.Types.Version import Pact.Types.Namespace import Crypto.Hash.Keccak256Native (Keccak256Error(..), keccak256) import Crypto.Hash.PoseidonNative (poseidon) -import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) +import Crypto.Hash.HyperlaneNatives (hyperlaneMessageId, hyperlaneDecodeTokenMessage, hyperlaneEncodeTokenMessage) import qualified Pact.JSON.Encode as J -import qualified Pact.JSON.Decode as J -- | All production native modules. natives :: [NativeModule] @@ -1655,6 +1645,7 @@ hyperlaneDefs :: NativeModule hyperlaneDefs = ("Hyperlane",) [ hyperlaneMessageIdDef , hyperlaneDecodeTokenMessageDef + , hyperlaneEncodeTokenMessageDef ] hyperlaneMessageIdDef :: NativeDef @@ -1663,27 +1654,27 @@ hyperlaneMessageIdDef = defGasRNative hyperlaneMessageId' (funType tTyString [("x", tTyObjectAny)]) [ - "(hyperlane-message-id {\"destinationDomain\": 1,\"nonce\": 325,\"originDomain\": 626,\"recipient\": \"0x71C7656EC7ab88b098defB751B7401B5f6d8976F\",\"sender\": \"0x6b622d746f6b656e2d726f75746572\",\"tokenMessage\": {\"amount\": 10000000000000000000.0,\"recipient\": \"0x71C7656EC7ab88b098defB751B7401B5f6d8976F\"},\"version\": 1})" + "(hyperlane-message-id {\"destinationDomain\": 1,\"nonce\": 325,\"originDomain\": 626,\"recipient\": \"AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU\",\"sender\": \"AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY\",\"messageBody\": \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\",\"version\": 1})" ] "Get the Message Id of a Hyperlane Message object." where hyperlaneMessageId' :: RNativeFun e hyperlaneMessageId' i args = case args of [TObject o _] -> - computeGas' i (GHyperlaneMessageId (BS.length (getTokenRecipient o))) - $ return $ toTerm $ hyperlaneMessageId o + computeGas' i (GHyperlaneMessageId (BS.length (getMessageBody o))) $ + case hyperlaneMessageId o of + Left err -> evalError' i err + Right msgId -> return $ toTerm msgId _ -> argsError i args - getTokenRecipient :: Object n -> BS.ByteString - getTokenRecipient o = - let mRecipient = do + getMessageBody :: Object n -> BS.ByteString + getMessageBody o = + let mBody = do let om = _objectMap (_oObject o) - tokenObject <- om ^? at "tokenMessage" . _Just . _TObject . _1 - let tm = _objectMap (_oObject tokenObject) - tm ^? at "recipient" . _Just . _TLiteral . _1 . _LString + om ^? at "messageBody" . _Just . _TLiteral . _1 . _LString in - case mRecipient of - Nothing -> error "couldn't decode token recipient" + case mBody of + Nothing -> error "couldn't find message body" Just t -> T.encodeUtf8 t hyperlaneDecodeTokenMessageDef :: NativeDef @@ -1697,108 +1688,37 @@ hyperlaneDecodeTokenMessageDef = 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 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). computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ - 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 - -- 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). - -- 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. - Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e - Left _ -> evalError' i "Decoding error: binary decoding failed" - Right (_,_,(amount, chain, recipient)) -> - case PGuard <$> J.eitherDecode (BS.fromStrict $ T.encodeUtf8 recipient) of - Left _ -> evalError' i $ "Could not parse recipient into a guard" - Right g -> - pure $ toTObject TyAny def - [("recipient", fromPactValue g) - ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def) - ,("chainId", toTerm chain) - ] + case hyperlaneDecodeTokenMessage msg of + Left err -> evalError' i err + Right term -> pure term _ -> 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 - -- 0000000000000000000000000000000000000000000000000000000000000062 # recipientSize = 98 - -- 7B2270726564223A20226B6579732D616C6C222C20226B657973223A205B2264 # {"pred": "keys-all", "keys": ["da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6"]} - -- 6131613333396264383264326332653931383036323661303064633034333237 - -- 3564656233616261626232376235373338616266366239646365653864623622 - -- 5D7D - getTokenMessageERC20 :: Get (Word256, ChainId, Text) - getTokenMessageERC20 = do - - -- Parse the size of the following amount field. - firstOffset <- fromIntegral @Word256 @Int <$> getWord256be - unless (firstOffset == 96) - (fail $ "TokenMessage firstOffset expected 96, found " ++ show firstOffset) - tmAmount <- getWord256be - tmChainId <- getWord256be - - recipientSize <- getWord256be - tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize - - return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient) - where - getWord256be = get @Word256 - - -- | 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 "TokenMessage recipient was smaller than expected" - else pure recipient - - - wordToDecimal :: Word256 -> Decimal - wordToDecimal w = - 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 -encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encodeUnpadded (BS.toStrict bytes) +hyperlaneEncodeTokenMessageDef :: NativeDef +hyperlaneEncodeTokenMessageDef = + defGasRNative + "hyperlane-encode-token-message" + hyperlaneEncodeTokenMessageDef' + (funType tTyObjectAny [("x", tTyString)]) + ["(hyperlane-encode-token-message {recipient:GUARD, amount:DECIMAL, chainId:STRING})"] + "Encode an object into a base-64-unpadded encoded Hyperlane Token Message `AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA`." where - bytes = runPut $ do - putWord256be (96 :: Word256) - putWord256be amount - putWord256be chain - putWord256be recipientSize - putByteString recipientBytes - - (recipientBytes, recipientSize) = padRight recipient - - putWord256be :: Word256 -> Put - putWord256be = put @Word256 - -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 + hyperlaneEncodeTokenMessageDef' :: RNativeFun e + hyperlaneEncodeTokenMessageDef' i args = case args of + [TObject o _] -> + computeGas' i (GHyperlaneEncodeTokenMessage (BS.length (getRecipient o))) $ + case hyperlaneEncodeTokenMessage o of + Left err -> evalError' i err + Right msg -> pure $ toTerm $ msg + _ -> argsError i args + + getRecipient :: Object n -> BS.ByteString + getRecipient o = + let mRecipient = do + let om = _objectMap (_oObject o) + om ^? at "recipient" . _Just . _TLiteral . _1 . _LString + in + case mRecipient of + Nothing -> error "couldn't find recipient" + Just t -> T.encodeUtf8 t diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index 6c14392f9..cb46bd194 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -184,11 +184,14 @@ data GasArgs -- ^ Cost of the hack-a-chain poseidon hash on this given number of inputs | GHyperlaneMessageId !Int -- ^ Cost of the hyperlane-message-id on this size (in bytes) of the - -- hyperlane TokenMessage Recipient, which is the only variable-length + -- hyperlane Message Body, which is the only variable-length -- part of a HyperlaneMessage | GHyperlaneDecodeTokenMessage !Int -- ^ Cost of hyperlane-decode-token-message on this size (in bytes) of the -- hyperlane TokenMessage base64-encoded string. + | GHyperlaneEncodeTokenMessage !Int + -- ^ Cost of hyperlane-encode-token-message on this size (in bytes) of the + -- hyperlane TokenMessage base64-encoded string. | GKeccak256 !(V.Vector Int) -- ^ Cost of hash-keccak256 given the number of bytes in each chunk. @@ -261,6 +264,7 @@ instance Pretty GasArgs where GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len GHyperlaneMessageId len -> "GHyperlaneMessageId:" <> pretty len GHyperlaneDecodeTokenMessage len -> "GHyperlaneDecodeTokenMessage:" <> pretty len + GHyperlaneEncodeTokenMessage len -> "GHyperlaneEncodeTokenMessage:" <> pretty len GKeccak256 chunksBytes -> "GKeccak256:" <> pretty (V.toList chunksBytes) newtype GasLimit = GasLimit ParsedInteger diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index cbfc67953..9d8c0c9ad 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -92,6 +92,7 @@ untestedNativesCheck = do , "list" , "continue" , "hyperlane-decode-token-message" + , "hyperlane-encode-token-message" ]) allGasTestsAndGoldenShouldPass :: Spec diff --git a/tests/HyperlaneSpec.hs b/tests/HyperlaneSpec.hs index 933e6e163..d214d961d 100644 --- a/tests/HyperlaneSpec.hs +++ b/tests/HyperlaneSpec.hs @@ -1,39 +1,118 @@ {-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module HyperlaneSpec (spec) where import Control.Lens ((^?), at, _Just, _1) -import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) +import Crypto.Hash.HyperlaneNatives (HyperlaneMessage(..), TokenMessageERC20(..), hyperlaneMessageId, decodeHyperlaneMessageObject, packTokenMessageERC20, unpackTokenMessageERC20) +import Data.Binary.Get qualified as Bin import Data.Default (def) +import Data.ByteString.Builder qualified as BB +import Data.ByteString.Lazy qualified as BL +import Data.Either (fromRight) import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) -import Pact.Types.Runtime (FieldKey, Object(..), ObjectMap(..), Term, Literal(..), tLit, tStr, asString, toTObject, Type(..), _TObject) +import Data.Text.Encoding qualified as Text +import Pact.Types.Runtime (FieldKey, Object(..), ObjectMap(..), Term, Literal(..), tLit, tStr, asString, toTObject, Type(..), _TObject, Name) +import Pact.Types.Util (decodeBase64UrlUnpadded, encodeBase64UrlUnpadded) import Test.Hspec +data Reference = Reference + { object :: Object Name + , tokenMessageText :: Text + , messageId :: Text + } + +testRefs :: [Reference] -> Spec +testRefs refs = describe "hyperlane" $ mapM_ (uncurry testRef) (zip [0..] refs) + where + testRef :: Word -> Reference -> Spec + testRef refId ref = describe ("reference " <> show refId) $ do + + let + hyperlaneMessageObject :: Object Name + hyperlaneMessageObject + | Just message <- unwrapObject ref.object ^? at "message" . _Just . _TObject . _1 = message + | otherwise = error "Extracting HyperlaneMessage Object failed" + + let + hyperlaneMessage :: HyperlaneMessage + hyperlaneMessage = fromRight (error "Decoding reference hyperlane message failed") $ do + decodeHyperlaneMessageObject hyperlaneMessageObject + + let + tokenMessage :: TokenMessageERC20 + tokenMessage = Bin.runGet unpackTokenMessageERC20 (BL.fromStrict (hmMessageBody hyperlaneMessage)) + + it "Computes the correct message id" $ do + hyperlaneMessageId hyperlaneMessageObject `shouldBe` Right ref.messageId + + it "TokenMessage encoding matches reference" $ do + let hexMessage = Text.decodeUtf8 (encodeBase64UrlUnpadded (BL.toStrict (BB.toLazyByteString (packTokenMessageERC20 tokenMessage)))) + hexMessage `shouldBe` ref.tokenMessageText + + -- TODO: This only applies on ETH -> KDA (when TokenMessage recipient is a guard) + --it "TokenMessage decodes properly into a Pact Term" $ do + -- hyperlaneDecodeTokenMessage ref.tokenMessageText `shouldBe` tokenMessageToTerm tokenMessage + +-- Recipient info +-- ETH -> KDA = Guard +-- KDA -> ETH = ETH Address + spec :: Spec -spec = describe "hyperlane" $ do - describe "hyperlane-message-id" $ do - it "computes the correct message id" $ do - let obj' = mkObject - [ ("message",) $ obj - [ ("version", tLit $ LInteger 1) - , ("nonce", tLit $ LInteger 325) - , ("originDomain", tLit $ LInteger 626) - , ("sender", tStr $ asString ("0x6b622d746f6b656e2d726f75746572" :: Text)) - , ("destinationDomain", tLit $ LInteger 1) - , ("recipient", tStr $ asString ("0x71C7656EC7ab88b098defB751B7401B5f6d8976F" :: Text)) - , ("tokenMessage", obj - [ ("recipient", tStr $ asString ("0x71C7656EC7ab88b098defB751B7401B5f6d8976F" :: Text)) - , ("amount", tLit $ LDecimal 10000000000000000000) - ] - ) - ] - ] - Just message <- pure (unwrapObject obj' ^? at "message" . _Just . _TObject . _1) - hyperlaneMessageId message `shouldBe` "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" +spec = testRefs + [ let + tokenMsgText = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ BL.toStrict $ BB.toLazyByteString $ + packTokenMessageERC20 $ TokenMessageERC20 + { tmAmount = 10 + , tmChainId = 0 + , tmRecipient = Text.encodeUtf8 "{\"pred\":\"keys-all\",\"keys\":[\"e5db35973f544642cb8b1539cb8bdf039cfe11e5f7e1127a146bd2a6d13d28c4\"]}" + } + in + Reference + { object = mkObject + [ ("message",) $ obj + [ ("version", tLit $ LInteger 3) + , ("nonce", tLit $ LInteger 0) + , ("originDomain", tLit $ LInteger 31_337) + , ("sender", tStr $ asString ("AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY" :: Text)) + , ("destinationDomain", tLit $ LInteger 626) + , ("recipient", tStr $ asString ("AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU" :: Text)) + , ("messageBody", tStr tokenMsgText) + ] + ] + , messageId = "E9W6As6Nqv0tW66uxgQjzKekSS23utRfWzwsIN7HEqw" + , tokenMessageText = tokenMsgText + } + , let + tokenMsgText = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ BL.toStrict $ BB.toLazyByteString $ + packTokenMessageERC20 $ TokenMessageERC20 + { tmAmount = 10 + , tmChainId = 0 + , tmRecipient = fromRight (error "failed to decode TokenMessage recipient") $ decodeBase64UrlUnpadded "cSOeAK6UKzlLOpGrIp5SZK2Db28" + } + in + Reference + { object = mkObject + [ ("message",) $ obj + [ ("version", tLit $ LInteger 3) + , ("nonce", tLit $ LInteger 0) + , ("originDomain", tLit $ LInteger 31_337) + , ("sender", tStr $ asString ("AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY" :: Text)) + , ("destinationDomain", tLit $ LInteger 626) + , ("recipient", tStr $ asString ("AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU" :: Text)) + , ("messageBody", tStr tokenMsgText) + ] + ] + , messageId = "kJGRc6EIp8d5c2jWYE87_X64P-MQGP8zrCLJ0GyjNE4" + , tokenMessageText = tokenMsgText + } + ] mkObject :: [(FieldKey, Term n)] -> Object n mkObject ps = Object (ObjectMap (Map.fromList ps)) TyAny Nothing def diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl index 90e8bd781..ac046523e 100644 --- a/tests/pact/hyperlane.repl +++ b/tests/pact/hyperlane.repl @@ -4,7 +4,7 @@ { "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})) +(expect "computes the correct message id" "0x3cbd30e222a483f3ad52191674b2f6951adb88636553d10f69a4a002ffd6c8d4" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1})) ; Decoding a valid TokenMessage should succeed. (expect "decodes the correct TokenMessage" @@ -15,11 +15,6 @@ (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") ) -; Decoding a valid TokenMessage should succeed. -(expect-failure "decoding fails for base64-padded messages" - (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==") -) - ; This TokenMessage was encoded with the recipient ; "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69". ; It should fail to decode because "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69" @@ -33,10 +28,14 @@ (env-gasmodel "table") (env-gaslimit 10000) -(env-gas) +(env-gas 0) (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)) + +(env-gas 0) +(hyperlane-encode-token-message {"amount": 599.0,"chainId": "1","recipient": "{\"pred\": \"keys-all\", \"keys\":[\"da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6\"]}"}) +(expect "Encoding a message with should cost 2 gas" 2 (env-gas))