add hyperlane-message-id native

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=
+

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)
@@ -466,6 +470,7 @@ test-suite hspec
       GasModelSpec
       GoldenSpec
       HistoryServiceSpec
+      HyperlaneSpec
       PactContinuationSpec
       PersistSpec
       PoseidonSpec

src/Crypto/Hash/HyperlaneMessageId.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+
+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/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,40 @@ 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)])
+  [
+    "(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
+    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

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)