From 37acd74d3857e4e41e1eca3e901eb7628506d07e Mon Sep 17 00:00:00 2001 From: chessai Date: Mon, 12 Feb 2024 16:15:07 -0600 Subject: [PATCH 01/15] add hyperlane-message-id native --- cabal.project | 21 +-- pact.cabal | 4 + src/Crypto/Hash/HyperlaneMessageId.hs | 201 ++++++++++++++++++++++++++ src/Pact/Gas/Table.hs | 6 + src/Pact/Native.hs | 38 +++++ src/Pact/Types/Gas.hs | 5 + 6 files changed, 266 insertions(+), 9 deletions(-) create mode 100644 src/Crypto/Hash/HyperlaneMessageId.hs diff --git a/cabal.project b/cabal.project index a6435cf99..d0513719e 100644 --- a/cabal.project +++ b/cabal.project @@ -1,17 +1,17 @@ packages: . +source-repository-package + type: git + location: https://github.com/kadena-io/pact-json.git + tag: 1d260bfaa48312b54851057885de4c43c420e35f + --sha256: 0fzq4mzaszj5clvixx9mn1x6r4dcrnwvbl2znd0p5mmy5h2jr0hh + -- temporary upper bounds constraints: sbv <10 -- test upper bounds constraints: hspec-golden <0.2, -source-repository-package - type: git - tag: e43073d0b8d89d9b300980913b842f4be339846d - location: https://github.com/kadena-io/pact-json - --sha256: sha256-ZWbAId0JBaxDsYhwcYUyw04sjYstXyosSCenzOvUxsQ= - -- These packages are tightly bundled with GHC. The rules ensure that -- our builds use the version that ships with the GHC version that is -- used for the build. @@ -38,6 +38,9 @@ allow-newer: servant:* -- Required by trifecta (e.g. to allow mtl >=2.3) allow-newer: trifecta:* --- servant-0.20 does not yet support aeson-2.2 --- -constraints: aeson <2.2 +source-repository-package + type: git + location: https://github.com/kadena-io/kadena-ethereum-bridge.git + tag: ffbf20e9f0430b95448bd66c6b1b530864397fb3 + --sha256: sha256-xdawv/tdjh61MbJKcBqm9Fje36+gVljuZsAxOTX1gP0= + diff --git a/pact.cabal b/pact.cabal index d96ae497e..8ce7b4b18 100644 --- a/pact.cabal +++ b/pact.cabal @@ -80,6 +80,7 @@ library -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + -Wno-missed-extra-shared-lib c-sources: cbits/musl/__math_invalid.c cbits/musl/__math_divzero.c @@ -96,6 +97,7 @@ library cbits/musl/sqrt_data.c exposed-modules: Crypto.Hash.Blake2Native + Crypto.Hash.HyperlaneMessageId Crypto.Hash.PoseidonNative Pact.Analyze.Remote.Types Pact.ApiReq @@ -224,6 +226,7 @@ library , filepath >=1.4.1.0 , groups , hashable >=1.4 + , ethereum >= 0.1 , lens >=4.14 , megaparsec >=9 , memory @@ -254,6 +257,7 @@ library , vector >=0.11.0.0 , vector-algorithms >=0.7 , vector-space >=0.10.4 + , wide-word >= 0.1 , yaml if flag(build-tool) diff --git a/src/Crypto/Hash/HyperlaneMessageId.hs b/src/Crypto/Hash/HyperlaneMessageId.hs new file mode 100644 index 000000000..adc606697 --- /dev/null +++ b/src/Crypto/Hash/HyperlaneMessageId.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} + +module Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId, benchy) where + +import Control.Lens ((^?), at, _Just, _Right, _1, to) +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.List qualified as List +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 + +import Gauge.Main + +hyperlaneMessageId :: Object Name -> Text +hyperlaneMessageId o = case decodeHyperlaneMessageObject o of + Nothing -> error "Couldn't decode HyperlaneMessage" + Just hm -> getHyperlaneMessageId hm + +benchy :: IO () +benchy = do + defaultMain + [ bgroup "hyperlane" + [ bench "0" $ whnf getHyperlaneMessageId hm0 + , bench "10" $ whnf getHyperlaneMessageId hm10 + , bench "20" $ whnf getHyperlaneMessageId hm20 + , bench "50" $ whnf getHyperlaneMessageId hm50 + , bench "100" $ whnf getHyperlaneMessageId hm100 + , bench "500" $ whnf getHyperlaneMessageId hm500 + , bench "1000" $ whnf getHyperlaneMessageId hm1000 + , bench "10000" $ whnf getHyperlaneMessageId hm10000 + ] + ] + +hm0, hm10, hm20, hm50, hm100, hm500, hm1000, hm10000 :: HyperlaneMessage +hm0 = genHM 0 +hm10 = genHM 10 +hm20 = genHM 20 +hm50 = genHM 50 +hm100 = genHM 100 +hm500 = genHM 500 +hm1000 = genHM 1_000 +hm10000 = genHM 10_000 + +genHM :: Int -> HyperlaneMessage +genHM recipientSize = HyperlaneMessage + { hmVersion = 0 + , hmNonce = 0 + , hmOriginDomain = 0 + , hmSender = BS.replicate 32 0 + , hmDestinationDomain = 0 + , hmRecipient = BS.replicate 32 0 + , hmTokenMessage = TokenMessageERC20 + { tmRecipient = Text.pack $ List.replicate recipientSize 'A' + , tmAmount = 0 + , tmChainId = Nothing + } + } +{-# noinline genHM #-} + +---------------------------------------------- +-- 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 -> Either String ByteString +decodeHex s + | Just h <- Text.stripPrefix "0x" s = Base16.decode (Text.encodeUtf8 h) + | otherwise = Left "decodeHex: does not start with 0x" + +---------------------------------------------- +-- Hyperlane Pact Object Decoding -- +---------------------------------------------- + +decodeHyperlaneMessageObject :: Object Name -> Maybe HyperlaneMessage +decodeHyperlaneMessageObject o = do + let om = _objectMap (_oObject o) + + hmVersion <- om ^? at "version" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral + hmNonce <- om ^? at "nonce" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral + hmOriginDomain <- om ^? at "originDomain" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral + hmSender <- om ^? at "sender" . _Just . _TLiteral . _1 . _LString . to Text.encodeUtf8 + hmDestinationDomain <- om ^? at "destinationDomain" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral + hmRecipient <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString . to decodeHex . _Right + + 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 <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString + tmAmount <- om ^? at "amount" . _Just . _TLiteral . _1 . _LDecimal . to decimalToWord + let tmChainId = Nothing + pure $ TokenMessageERC20{..} + +decimalToWord :: Decimal -> Word256 +decimalToWord d = + let ethInWei = 1000000000000000000 -- 1e18 + in round $ d * ethInWei diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 0e154e017..a0b1f8785 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -55,6 +55,7 @@ data GasCostConfig = GasCostConfig , _gasCostConfig_formatBytesPerGas :: Gas , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas + , _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte :: MilliGas } defaultGasConfig :: GasCostConfig @@ -81,6 +82,7 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_formatBytesPerGas = 10 , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50 , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38 + , _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte = MilliGas undefined } defaultGasTable :: Map Text Gas @@ -236,6 +238,7 @@ defaultGasTable = ,("pairing-check", 1) ,("poseidon-hash-hack-a-chain", 124) + ,("hyperlane-message-id", error "sus") ] {-# NOINLINE defaultGasTable #-} @@ -333,6 +336,9 @@ tableGasModel gasConfig = gasToMilliGas $ _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor gasConfig * fromIntegral (len * len) + _gasCostConfig_poseidonHashHackAChainLinearGasFactor gasConfig * fromIntegral len + GHyperlaneMessageId len -> + let MilliGas costPerByte = _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte gasConfig + in MilliGas (costPerByte * fromIntegral len) in GasModel { gasModelName = "table" diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index eb9b2c45d..e3bc26333 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -5,6 +5,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} -- | @@ -107,6 +108,7 @@ import Pact.Types.Runtime import Pact.Types.Version import Pact.Types.Namespace import Crypto.Hash.PoseidonNative (poseidon) +import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) import qualified Pact.JSON.Encode as J @@ -124,6 +126,7 @@ natives = , guardDefs , zkDefs , poseidonHackAChainDefs + , hyperlaneDefs ] @@ -1569,3 +1572,38 @@ poseidonHackAChainDef = defGasRNative = computeGas' i (GPoseidonHashHackAChain $ length as) $ return $ toTerm $ poseidon intArgs | otherwise = argsError i as + +hyperlaneDefs :: NativeModule +hyperlaneDefs = ("Hyperlane",) + [ hyperlaneMessageIdDef + ] + +hyperlaneMessageIdDef :: NativeDef +hyperlaneMessageIdDef = defGasRNative + "hyperlane-message-id" + hyperlaneMessageId' + (funType tTyString [("x", tTyObjectAny)]) + [] + "Get the Message Id of a Hyperlane Message object." + where + hyperlaneMessageId' :: RNativeFun e + hyperlaneMessageId' i args = case args of + [TObject o _] -> + let + tokenRecipient :: BS.ByteString + tokenRecipient = + let + mRecipient :: Maybe Text + mRecipient = 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 + in + case mRecipient of + Nothing -> error "couldn't decode token recipient" + Just t -> T.encodeUtf8 t + in + computeGas' i (GHyperlaneMessageId (BS.length tokenRecipient)) + $ return $ toTerm $ hyperlaneMessageId o + _ -> argsError i args diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index 406e08383..1aeb8e48a 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -182,6 +182,10 @@ data GasArgs -- ^ Cost of formatting with the given format string and args | GPoseidonHashHackAChain !Int -- ^ 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 + -- part of a HyperlaneMessage data IntOpThreshold = Pact43IntThreshold @@ -250,6 +254,7 @@ instance Pretty GasArgs where GReverse len -> "GReverse:" <> pretty len GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args) GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len + GHyperlaneMessageId len -> "GHyperlaneMessageId:" <> pretty len newtype GasLimit = GasLimit ParsedInteger deriving (Eq,Ord,Generic) From b2ddfe4a56dfa0999c49bcbbab00f3a7a268cd33 Mon Sep 17 00:00:00 2001 From: chessai Date: Mon, 12 Feb 2024 16:28:24 -0600 Subject: [PATCH 02/15] remove benchmark code --- src/Crypto/Hash/HyperlaneMessageId.hs | 50 +++------------------------ 1 file changed, 5 insertions(+), 45 deletions(-) diff --git a/src/Crypto/Hash/HyperlaneMessageId.hs b/src/Crypto/Hash/HyperlaneMessageId.hs index adc606697..e2ea9e71b 100644 --- a/src/Crypto/Hash/HyperlaneMessageId.hs +++ b/src/Crypto/Hash/HyperlaneMessageId.hs @@ -8,7 +8,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} -module Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId, benchy) where +module Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) where import Control.Lens ((^?), at, _Just, _Right, _1, to) import Data.ByteString (ByteString) @@ -19,63 +19,23 @@ 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.List qualified as List 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 +import Pact.Types.Runtime (Object(..), ObjectMap(..), Name, _TLiteral, _TObject, _LDecimal, _LInteger, _LString) -import Gauge.Main +---------------------------------------------- +-- Primitive -- +---------------------------------------------- hyperlaneMessageId :: Object Name -> Text hyperlaneMessageId o = case decodeHyperlaneMessageObject o of Nothing -> error "Couldn't decode HyperlaneMessage" Just hm -> getHyperlaneMessageId hm -benchy :: IO () -benchy = do - defaultMain - [ bgroup "hyperlane" - [ bench "0" $ whnf getHyperlaneMessageId hm0 - , bench "10" $ whnf getHyperlaneMessageId hm10 - , bench "20" $ whnf getHyperlaneMessageId hm20 - , bench "50" $ whnf getHyperlaneMessageId hm50 - , bench "100" $ whnf getHyperlaneMessageId hm100 - , bench "500" $ whnf getHyperlaneMessageId hm500 - , bench "1000" $ whnf getHyperlaneMessageId hm1000 - , bench "10000" $ whnf getHyperlaneMessageId hm10000 - ] - ] - -hm0, hm10, hm20, hm50, hm100, hm500, hm1000, hm10000 :: HyperlaneMessage -hm0 = genHM 0 -hm10 = genHM 10 -hm20 = genHM 20 -hm50 = genHM 50 -hm100 = genHM 100 -hm500 = genHM 500 -hm1000 = genHM 1_000 -hm10000 = genHM 10_000 - -genHM :: Int -> HyperlaneMessage -genHM recipientSize = HyperlaneMessage - { hmVersion = 0 - , hmNonce = 0 - , hmOriginDomain = 0 - , hmSender = BS.replicate 32 0 - , hmDestinationDomain = 0 - , hmRecipient = BS.replicate 32 0 - , hmTokenMessage = TokenMessageERC20 - { tmRecipient = Text.pack $ List.replicate recipientSize 'A' - , tmAmount = 0 - , tmChainId = Nothing - } - } -{-# noinline genHM #-} - ---------------------------------------------- -- Hyperlane Message Encoding -- ---------------------------------------------- From f1b629c141c6d304ce4807c05c1475d9a37bd7f8 Mon Sep 17 00:00:00 2001 From: chessai Date: Mon, 12 Feb 2024 17:15:39 -0600 Subject: [PATCH 03/15] add unit test --- pact.cabal | 1 + src/Pact/Gas/Table.hs | 10 +++++----- tests/HyperlaneSpec.hs | 45 ++++++++++++++++++++++++++++++++++++++++++ tests/PactTests.hs | 2 ++ 4 files changed, 53 insertions(+), 5 deletions(-) create mode 100644 tests/HyperlaneSpec.hs diff --git a/pact.cabal b/pact.cabal index 8ce7b4b18..9add34501 100644 --- a/pact.cabal +++ b/pact.cabal @@ -470,6 +470,7 @@ test-suite hspec GasModelSpec GoldenSpec HistoryServiceSpec + HyperlaneSpec PactContinuationSpec PersistSpec PoseidonSpec diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index a0b1f8785..a2725b57d 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -55,7 +55,7 @@ data GasCostConfig = GasCostConfig , _gasCostConfig_formatBytesPerGas :: Gas , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas - , _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte :: MilliGas + , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas } defaultGasConfig :: GasCostConfig @@ -82,7 +82,7 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_formatBytesPerGas = 10 , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50 , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38 - , _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte = MilliGas undefined + , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47 } defaultGasTable :: Map Text Gas @@ -238,7 +238,7 @@ defaultGasTable = ,("pairing-check", 1) ,("poseidon-hash-hack-a-chain", 124) - ,("hyperlane-message-id", error "sus") + ,("hyperlane-message-id", 1121) ] {-# NOINLINE defaultGasTable #-} @@ -337,8 +337,8 @@ tableGasModel gasConfig = _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor gasConfig * fromIntegral (len * len) + _gasCostConfig_poseidonHashHackAChainLinearGasFactor gasConfig * fromIntegral len GHyperlaneMessageId len -> - let MilliGas costPerByte = _gasCostConfig_hyperlaneMessageIdGasPerRecipientByte gasConfig - in MilliGas (costPerByte * fromIntegral len) + let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes gasConfig + in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100) in GasModel { gasModelName = "table" diff --git a/tests/HyperlaneSpec.hs b/tests/HyperlaneSpec.hs new file mode 100644 index 000000000..933e6e163 --- /dev/null +++ b/tests/HyperlaneSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +module HyperlaneSpec (spec) where + +import Control.Lens ((^?), at, _Just, _1) +import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) +import Data.Default (def) +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 Test.Hspec + +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" + +mkObject :: [(FieldKey, Term n)] -> Object n +mkObject ps = Object (ObjectMap (Map.fromList ps)) TyAny Nothing def + +obj :: [(FieldKey, Term n)] -> Term n +obj = toTObject TyAny def + +unwrapObject :: Object n -> Map FieldKey (Term n) +unwrapObject o = _objectMap (_oObject o) diff --git a/tests/PactTests.hs b/tests/PactTests.hs index 661eee9ef..f8cedd77c 100644 --- a/tests/PactTests.hs +++ b/tests/PactTests.hs @@ -24,6 +24,7 @@ import qualified DocgenSpec import qualified GasModelSpec import qualified GoldenSpec import qualified HistoryServiceSpec +import qualified HyperlaneSpec import qualified PactContinuationSpec import qualified PersistSpec import qualified RemoteVerifySpec @@ -60,6 +61,7 @@ main = hspec $ parallel $ do describe "GasModelSpec" GasModelSpec.spec describe "GoldenSpec" GoldenSpec.spec describe "HistoryServiceSpec" HistoryServiceSpec.spec + describe "HyperlaneSpec" HyperlaneSpec.spec describe "PactContinuationSpec" PactContinuationSpec.spec describe "PersistSpec" PersistSpec.spec describe "RemoteVerifySpec" RemoteVerifySpec.spec From 843d41ca8eaeebed859265087bbe15e24bac35c7 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:10:56 -0600 Subject: [PATCH 04/15] convert milligas to gas in hyperlane-message-id defaultGasTable --- 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 a2725b57d..edba74289 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -238,7 +238,7 @@ defaultGasTable = ,("pairing-check", 1) ,("poseidon-hash-hack-a-chain", 124) - ,("hyperlane-message-id", 1121) + ,("hyperlane-message-id", 1) ] {-# NOINLINE defaultGasTable #-} From ce99a62371abfe14106e563ba29c4f51fbb6bd9f Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:11:28 -0600 Subject: [PATCH 05/15] factor out repetitive prisms --- src/Crypto/Hash/HyperlaneMessageId.hs | 42 +++++++++++++++------------ 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/src/Crypto/Hash/HyperlaneMessageId.hs b/src/Crypto/Hash/HyperlaneMessageId.hs index e2ea9e71b..0ff516295 100644 --- a/src/Crypto/Hash/HyperlaneMessageId.hs +++ b/src/Crypto/Hash/HyperlaneMessageId.hs @@ -1,16 +1,15 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} module Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId) where -import Control.Lens ((^?), at, _Just, _Right, _1, to) +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 @@ -19,13 +18,15 @@ 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(..), Name, _TLiteral, _TObject, _LDecimal, _LInteger, _LString) +import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Literal, _TLiteral, _TObject, _LDecimal, _LInteger, _LString) +import Pact.Types.Term (Term) ---------------------------------------------- -- Primitive -- @@ -120,10 +121,10 @@ keccak256Hash = BSS.fromShort . _getBytesN . _getKeccak256Hash . keccak256 encodeHex :: ByteString -> Text encodeHex b = "0x" <> Text.decodeUtf8 (Base16.encode b) -decodeHex :: Text -> Either String ByteString -decodeHex s - | Just h <- Text.stripPrefix "0x" s = Base16.decode (Text.encodeUtf8 h) - | otherwise = Left "decodeHex: does not start with 0x" +decodeHex :: Text -> Maybe ByteString +decodeHex s = do + h <- Text.stripPrefix "0x" s + hush (Base16.decode (Text.encodeUtf8 h)) ---------------------------------------------- -- Hyperlane Pact Object Decoding -- @@ -133,12 +134,12 @@ decodeHyperlaneMessageObject :: Object Name -> Maybe HyperlaneMessage decodeHyperlaneMessageObject o = do let om = _objectMap (_oObject o) - hmVersion <- om ^? at "version" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral - hmNonce <- om ^? at "nonce" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral - hmOriginDomain <- om ^? at "originDomain" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral - hmSender <- om ^? at "sender" . _Just . _TLiteral . _1 . _LString . to Text.encodeUtf8 - hmDestinationDomain <- om ^? at "destinationDomain" . _Just . _TLiteral . _1 . _LInteger . to fromIntegral - hmRecipient <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString . to decodeHex . _Right + 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 @@ -150,12 +151,15 @@ decodeHyperlaneMessageObject o = do decodeTokenMessageERC20 :: Object Name -> Maybe TokenMessageERC20 decodeTokenMessageERC20 o = do let om = _objectMap (_oObject o) - tmRecipient <- om ^? at "recipient" . _Just . _TLiteral . _1 . _LString - tmAmount <- om ^? at "amount" . _Just . _TLiteral . _1 . _LDecimal . to decimalToWord + tmRecipient <- grabField om "recipient" _LString + tmAmount <- decimalToWord <$> grabField om "amount" _LDecimal let tmChainId = Nothing pure $ TokenMessageERC20{..} decimalToWord :: Decimal -> Word256 decimalToWord d = - let ethInWei = 1000000000000000000 -- 1e18 + 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 From eec672002f36f467b2d8e1afcd11245f79bea1cc Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:12:02 -0600 Subject: [PATCH 06/15] add hyperlane-message-id repl test --- tests/pact/hyperlane-message-id.repl | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 tests/pact/hyperlane-message-id.repl diff --git a/tests/pact/hyperlane-message-id.repl b/tests/pact/hyperlane-message-id.repl new file mode 100644 index 000000000..1fcfd5ee2 --- /dev/null +++ b/tests/pact/hyperlane-message-id.repl @@ -0,0 +1,3 @@ +;; Test hyperlane-message-id + +(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 01253f00521974ace199642d6d65638b5978c802 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:16:04 -0600 Subject: [PATCH 07/15] add example to hyperlane-message-id Pact Native --- src/Pact/Native.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index e3bc26333..702297cf5 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1583,7 +1583,9 @@ hyperlaneMessageIdDef = defGasRNative "hyperlane-message-id" 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})" + ] "Get the Message Id of a Hyperlane Message object." where hyperlaneMessageId' :: RNativeFun e From 0ea1b308d232a070637c1014021293a107b06ed3 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:25:19 -0600 Subject: [PATCH 08/15] round hyperlane-message-id gas constant up instead of down --- 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 edba74289..0b1fd40e3 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -238,7 +238,7 @@ defaultGasTable = ,("pairing-check", 1) ,("poseidon-hash-hack-a-chain", 124) - ,("hyperlane-message-id", 1) + ,("hyperlane-message-id", 2) ] {-# NOINLINE defaultGasTable #-} From a20e39a3913bc477bc5990d0343c886558f2c3fd Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:38:17 -0600 Subject: [PATCH 09/15] add module-level documentation to HyperlaneMessageId.hs --- src/Crypto/Hash/HyperlaneMessageId.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Crypto/Hash/HyperlaneMessageId.hs b/src/Crypto/Hash/HyperlaneMessageId.hs index 0ff516295..0685a2096 100644 --- a/src/Crypto/Hash/HyperlaneMessageId.hs +++ b/src/Crypto/Hash/HyperlaneMessageId.hs @@ -6,6 +6,11 @@ {-# 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) From e56372949eabb95bc1ce626aadc12db25ef6c24e Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 12:39:16 -0600 Subject: [PATCH 10/15] move ghc-option for no missed extra shared lib to cabal.project --- cabal.project | 3 +++ pact.cabal | 1 - 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index d0513719e..aa61dfae0 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,8 @@ packages: . +package pact + ghc-options: -Wno-missed-extra-shared-lib + source-repository-package type: git location: https://github.com/kadena-io/pact-json.git diff --git a/pact.cabal b/pact.cabal index 9add34501..8fba2af61 100644 --- a/pact.cabal +++ b/pact.cabal @@ -80,7 +80,6 @@ library -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints - -Wno-missed-extra-shared-lib c-sources: cbits/musl/__math_invalid.c cbits/musl/__math_divzero.c From a51220b03f0ac1fe1bac05dbf1a5de9a969f339b Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 15:20:34 -0600 Subject: [PATCH 11/15] move demon let into where --- golden/gas-model/golden | 4 ++++ src/Pact/GasModel/GasTests.hs | 10 ++++++++++ 2 files changed, 14 insertions(+) diff --git a/golden/gas-model/golden b/golden/gas-model/golden index fd8b74a79..9d4229159 100644 --- a/golden/gas-model/golden +++ b/golden/gas-model/golden @@ -597,6 +597,10 @@ "8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a" "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}) + - 4 - - (^ 2 longNumber) - 4 - - (^ 2 medNumber) diff --git a/src/Pact/GasModel/GasTests.hs b/src/Pact/GasModel/GasTests.hs index 31e9aecb5..0bd282643 100644 --- a/src/Pact/GasModel/GasTests.hs +++ b/src/Pact/GasModel/GasTests.hs @@ -223,6 +223,8 @@ allTests = HM.fromList , ("pairing-check", pairingCheckTests) , ("poseidon-hash-hack-a-chain", poseidonHashTests) + , ("hyperlane-message-id", hyperlaneMessageIdTests) + -- Non-native concepts to benchmark , ("use", useTests) , ("module", moduleTests) @@ -2009,3 +2011,11 @@ poseidonHashTests = defGasUnitTest $ PactExpression poseidonHashExprText Nothing (poseidon-hash-hack-a-chain 1 2) (poseidon-hash-hack-a-chain 999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999 88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) |] + +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}) + |] From 9fdb3f11989e5fd0c5214009b17b787773965898 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 15:21:10 -0600 Subject: [PATCH 12/15] regenerate docs --- docs/en/pact-functions.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index 587ac8a03..aabb1511b 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -1815,6 +1815,19 @@ pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8) 18604317144381847857886385684060986177838410221561136253933256952257712543953 ``` +## Hyperlane {#Hyperlane} + +### hyperlane-message-id {#hyperlane-message-id} + +*x* `object:*` *→* `string` + + +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" +``` + ## REPL-only functions {#repl-lib} The following functions are loaded automatically into the interactive REPL, or within script files with a `.repl` extension. They are not available for blockchain-based execution. From 76b6173b808e5561a720def8210ce478860b023c Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 15:21:21 -0600 Subject: [PATCH 13/15] move demon let to where --- src/Pact/Native.hs | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 702297cf5..a49a9a749 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1591,21 +1591,18 @@ hyperlaneMessageIdDef = defGasRNative hyperlaneMessageId' :: RNativeFun e hyperlaneMessageId' i args = case args of [TObject o _] -> - let - tokenRecipient :: BS.ByteString - tokenRecipient = - let - mRecipient :: Maybe Text - mRecipient = 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 - in - case mRecipient of - Nothing -> error "couldn't decode token recipient" - Just t -> T.encodeUtf8 t - in - computeGas' i (GHyperlaneMessageId (BS.length tokenRecipient)) + computeGas' i (GHyperlaneMessageId (BS.length (getTokenRecipient o))) $ return $ toTerm $ hyperlaneMessageId o _ -> argsError i args + + getTokenRecipient :: Object n -> BS.ByteString + getTokenRecipient o = + let mRecipient = 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 + in + case mRecipient of + Nothing -> error "couldn't decode token recipient" + Just t -> T.encodeUtf8 t From 9383f5755fef412f079c19920e61527fc9d69b36 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 15:49:13 -0600 Subject: [PATCH 14/15] add a gas model golden test for enforce-verifier --- golden/gas-model/golden | 10 ++++++++++ src/Pact/GasModel/GasTests.hs | 25 +++++++++++++++++++++++++ tests/GasModelSpec.hs | 1 - 3 files changed, 35 insertions(+), 1 deletion(-) diff --git a/golden/gas-model/golden b/golden/gas-model/golden index 9d4229159..3f2ca1ce8 100644 --- a/golden/gas-model/golden +++ b/golden/gas-model/golden @@ -1003,6 +1003,16 @@ - 2 - - (>= (time "2016-07-22T12:00:00Z") (time "2018-07-22T12:00:00Z")) - 6 +- - |- + (module m GOV + (defcap GOV () true) + + (defcap GOOD () (enforce-verifier 'HYPERLANE)) + + (defun good () (with-capability (GOOD) 1)) + ) + (good) + - 59 - - (take 1 longNumberList) - 3 - - (take 1 medNumberList) diff --git a/src/Pact/GasModel/GasTests.hs b/src/Pact/GasModel/GasTests.hs index 0bd282643..6f804b7fd 100644 --- a/src/Pact/GasModel/GasTests.hs +++ b/src/Pact/GasModel/GasTests.hs @@ -23,6 +23,7 @@ import qualified Data.Aeson as A import qualified Data.Foldable as F import qualified Data.HashMap.Strict as HM import qualified Data.Map as M +import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -35,6 +36,7 @@ import Pact.Types.Capability import Pact.Types.Lang import Pact.Types.PactValue (PactValue(..)) import Pact.Types.Runtime +import Pact.Types.Verifier (VerifierName(..)) import Pact.JSON.Legacy.Value @@ -223,7 +225,9 @@ allTests = HM.fromList , ("pairing-check", pairingCheckTests) , ("poseidon-hash-hack-a-chain", poseidonHashTests) + -- SPI/Hyperlane , ("hyperlane-message-id", hyperlaneMessageIdTests) + , ("enforce-verifier", enforceVerifierTests) -- Non-native concepts to benchmark , ("use", useTests) @@ -2012,6 +2016,27 @@ poseidonHashTests = defGasUnitTest $ PactExpression poseidonHashExprText Nothing (poseidon-hash-hack-a-chain 999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999 88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888) |] +enforceVerifierTests :: NativeDefName -> GasUnitTests +enforceVerifierTests = createGasUnitTests signEnvWithKeySet signEnvWithKeySet [PactExpression enforceVerifierExprText Nothing] + where + verifMap :: M.Map VerifierName (S.Set SigCapability) + verifMap = M.fromList + [ (VerifierName "HYPERLANE", S.fromList [SigCapability (QualifiedName "m" "GOOD" def) []]) + ] + + signEnvWithKeySet = setEnv (set eeMsgVerifiers verifMap) + + enforceVerifierExprText = [text| + (module m GOV + (defcap GOV () true) + + (defcap GOOD () (enforce-verifier 'HYPERLANE)) + + (defun good () (with-capability (GOOD) 1)) + ) + (good) + |] + hyperlaneMessageIdTests :: NativeDefName -> GasUnitTests hyperlaneMessageIdTests = defGasUnitTest $ PactExpression hyperlaneMessageIdExprText Nothing where diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index b1ebded8b..184b91634 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -89,7 +89,6 @@ untestedNativesCheck = do , "verify-spv" , "public-chain-data" , "dec" - , "enforce-verifier" , "list" , "continue" ]) From a21115abd97867efcdabe213088c24049baa18f7 Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 13 Feb 2024 15:57:53 -0600 Subject: [PATCH 15/15] add hyperlane-message-id behind DisableVerifiers flag --- src/Pact/Interpreter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs index df8d5ca2a..aa87c951b 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -276,7 +276,7 @@ pact410Natives :: [Text] pact410Natives = ["poseidon-hash-hack-a-chain"] verifierNatives :: [Text] -verifierNatives = ["enforce-verifier"] +verifierNatives = ["enforce-verifier", "hyperlane-message-id"] initRefStore :: RefStore initRefStore = RefStore nativeDefs