add hyperlane-message-id native

cabal.project

@@ -1,17 +1,20 @@
 packages: .
 
+package pact
+    ghc-options: -Wno-missed-extra-shared-lib
+
+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 +41,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=
+

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.

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)
@@ -999,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)

pact.cabal

@@ -96,6 +96,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 +225,7 @@ library
     , filepath >=1.4.1.0
     , groups
     , hashable >=1.4
+    , ethereum >= 0.1
     , lens >=4.14
     , megaparsec >=9
     , memory
@@ -254,6 +256,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)
@@ -466,6 +469,7 @@ test-suite hspec
       GasModelSpec
       GoldenSpec
       HistoryServiceSpec
+      HyperlaneSpec
       PactContinuationSpec
       PersistSpec
       PoseidonSpec

src/Crypto/Hash/HyperlaneMessageId.hs

@@ -0,0 +1,170 @@
+{-# 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

src/Pact/Gas/Table.hs

@@ -55,6 +55,7 @@ data GasCostConfig = GasCostConfig
   , _gasCostConfig_formatBytesPerGas :: Gas
   , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas
   , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas
+  , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas
   }
 
 defaultGasConfig :: GasCostConfig
@@ -81,6 +82,7 @@ defaultGasConfig = GasCostConfig
   , _gasCostConfig_formatBytesPerGas = 10
   , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50
   , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38
+  , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47
   }
 
 defaultGasTable :: Map Text Gas
@@ -236,6 +238,7 @@ defaultGasTable =
   ,("pairing-check", 1)
 
   ,("poseidon-hash-hack-a-chain", 124)
+  ,("hyperlane-message-id", 2)
   ]
 
 {-# NOINLINE defaultGasTable #-}
@@ -333,6 +336,9 @@ tableGasModel gasConfig =
           gasToMilliGas $
             _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor gasConfig * fromIntegral (len * len) +
             _gasCostConfig_poseidonHashHackAChainLinearGasFactor gasConfig * fromIntegral len
+        GHyperlaneMessageId len ->
+          let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes gasConfig
+          in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
 
   in GasModel
       { gasModelName = "table"

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,6 +225,10 @@ 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)
     , ("module", moduleTests)
@@ -2009,3 +2015,32 @@ poseidonHashTests = defGasUnitTest $ PactExpression poseidonHashExprText Nothing
     (poseidon-hash-hack-a-chain 1 2)
     (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
+    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})
+    |]

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