Skip to content

Commit b16c8f5

Browse files
author
Evgenii Akentev
committed
Add hyperlane-encode-token-message native
1 parent c6efe69 commit b16c8f5

File tree

7 files changed

+88
-7
lines changed

7 files changed

+88
-7
lines changed

src/Crypto/Hash/HyperlaneNatives.hs

Lines changed: 42 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module Crypto.Hash.HyperlaneNatives
2222
-- Implementation of natives
2323
, hyperlaneMessageId
2424
, hyperlaneDecodeTokenMessage
25+
, hyperlaneEncodeTokenMessage
2526
) where
2627

2728
import Control.Lens ((^?), at, _Just, Prism', _1)
@@ -30,6 +31,7 @@ import Control.Monad.Except (throwError)
3031
import Data.Bifunctor (first)
3132
import Data.Binary.Get (Get)
3233
import Data.Binary.Get qualified as Bin
34+
import Data.Binary.Put qualified as Bin
3335
import Data.ByteString (ByteString)
3436
import Data.ByteString qualified as BS
3537
import Data.ByteString.Base16 qualified as Base16
@@ -45,16 +47,17 @@ import Data.Ratio ((%))
4547
import Data.Text (Text)
4648
import Data.Text qualified as Text
4749
import Data.Text.Encoding qualified as Text
50+
import Data.Text.Read qualified as Text
4851
import Data.WideWord.Word256 (Word256(..))
4952
import Data.Word (Word8, Word32)
5053
import Ethereum.Misc (keccak256, _getKeccak256Hash, _getBytesN)
5154
import Pact.JSON.Decode qualified as J
5255
import Pact.Types.Exp (Literal(..))
5356
import Pact.Types.PactValue (PactValue(PGuard), fromPactValue)
5457
import Pact.Types.Pretty (Doc, pretty)
55-
import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Type(TyAny), _TLiteral, _LInteger, _LString, toTObject, ChainId(..))
58+
import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Type(TyAny), _TLiteral, _LInteger, _LString, toTObject, ChainId(..), _LDecimal)
5659
import Pact.Types.Term (Term(..), toTerm)
57-
import Pact.Types.Util (decodeBase64UrlUnpadded)
60+
import Pact.Types.Util (decodeBase64UrlUnpadded, encodeBase64UrlUnpadded)
5861

5962
----------------------------------------------
6063
-- Primitives --
@@ -85,6 +88,13 @@ hyperlaneDecodeTokenMessage i = do
8588
pure tm
8689
tokenMessageToTerm tm
8790

91+
hyperlaneEncodeTokenMessage :: Object Name -> Either Doc Text
92+
hyperlaneEncodeTokenMessage o = do
93+
tm <- first displayHyperlaneMessageIdError $ do
94+
decodeHyperlaneTokenMessageObject o
95+
let encoded = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ BL.toStrict $ Bin.runPut (Bin.putBuilder $ packTokenMessageERC20 tm)
96+
return encoded
97+
8898
----------------------------------------------
8999
-- Error Types --
90100
----------------------------------------------
@@ -103,6 +113,7 @@ data HyperlaneMessageIdError
103113
-- ^ Invalid base64 text field.
104114
| HyperlaneMessageIdIncorrectSize FieldKey Int Int
105115
-- ^ Invalid Hex. We discard error messages from base16-bytestring to
116+
| HyperlaneMessageIdErrorInvalidChainId Text
106117

107118
displayHyperlaneMessageIdError :: HyperlaneMessageIdError -> Doc
108119
displayHyperlaneMessageIdError = \case
@@ -113,6 +124,7 @@ displayHyperlaneMessageIdError = \case
113124
HyperlaneMessageIdInvalidBase64 key -> "Invalid base64 encoding on field " <> pretty key
114125
HyperlaneMessageIdIncorrectSize key expected actual ->
115126
"Incorrect binary data size " <> pretty key <> ". Expected: " <> pretty expected <> ", but got " <> pretty actual
127+
HyperlaneMessageIdErrorInvalidChainId msg -> "Failed to decode chainId " <> pretty msg
116128

117129
data HyperlaneDecodeError
118130
= HyperlaneDecodeErrorBase64
@@ -269,9 +281,17 @@ decodeBase64AndValidate key expected s = do
269281

270282
return decoded
271283

272-
----------------------------------------------
273-
-- Hyperlane Pact Object Decoding --
274-
----------------------------------------------
284+
parseChainId :: Text -> Either HyperlaneMessageIdError Word256
285+
parseChainId s = do
286+
cid <- first (HyperlaneMessageIdErrorInvalidChainId . Text.pack) $ Text.decimal s
287+
288+
unless (fst cid >= 0) $ throwError $ HyperlaneMessageIdErrorInvalidChainId "ChainId can't be negative"
289+
return $ fst cid
290+
291+
292+
------------------------------------------------------
293+
-- Hyperlane Message Pact Object Decoding --
294+
------------------------------------------------------
275295

276296
decodeHyperlaneMessageObject :: Object Name -> Either HyperlaneMessageIdError HyperlaneMessage
277297
decodeHyperlaneMessageObject o = do
@@ -287,13 +307,30 @@ decodeHyperlaneMessageObject o = do
287307

288308
pure HyperlaneMessage{..}
289309

310+
------------------------------------------------------------
311+
-- Hyperlane Token Message Pact Object Decoding --
312+
------------------------------------------------------------
313+
314+
decodeHyperlaneTokenMessageObject :: Object Name -> Either HyperlaneMessageIdError TokenMessageERC20
315+
decodeHyperlaneTokenMessageObject o = do
316+
let om = _objectMap (_oObject o)
317+
318+
tmRecipient <- grabField om "recipient" _LString
319+
tmAmount <- decimalToWord <$> grabField om "amount" _LDecimal
320+
tmChainId <- parseChainId =<< grabField om "chainId" _LString
321+
322+
pure TokenMessageERC20{..}
323+
290324
----------------------------------------------
291325
-- Utilities --
292326
----------------------------------------------
293327

294328
wordToDecimal :: Word256 -> Decimal
295329
wordToDecimal w = fromRational (toInteger w % ethInWei)
296330

331+
decimalToWord :: Decimal -> Word256
332+
decimalToWord d = round $ d * ethInWei
333+
297334
ethInWei :: Num a => a
298335
ethInWei = 1_000_000_000_000_000_000 -- 1e18
299336
{-# inline ethInWei #-}

src/Pact/Gas/Table.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ data GasCostConfig = GasCostConfig
5858
, _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas
5959
, _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas
6060
, _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes :: MilliGas
61+
, _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes :: MilliGas
6162
, _gasCostConfig_keccak256GasPerOneHundredBytes :: MilliGas
6263
, _gasCostConfig_keccak256GasPerChunk :: MilliGas
6364
}
@@ -88,6 +89,7 @@ defaultGasConfig = GasCostConfig
8889
, _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38
8990
, _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47
9091
, _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 50
92+
, _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes = MilliGas 50
9193
, _gasCostConfig_keccak256GasPerOneHundredBytes = MilliGas 146
9294
, _gasCostConfig_keccak256GasPerChunk = MilliGas 2_120
9395
}
@@ -247,6 +249,7 @@ defaultGasTable =
247249
,("poseidon-hash-hack-a-chain", 124)
248250
,("hyperlane-message-id", 2)
249251
,("hyperlane-decode-token-message", 2)
252+
,("hyperlane-encode-token-message", 2)
250253
,("hash-keccak256",1)
251254
]
252255

@@ -351,6 +354,9 @@ tableGasModel gasConfig =
351354
GHyperlaneDecodeTokenMessage len ->
352355
let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes gasConfig
353356
in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
357+
GHyperlaneEncodeTokenMessage len ->
358+
let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneEncodeTokenMessageGasPerOneHundredBytes gasConfig
359+
in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
354360
GKeccak256 chunkBytes ->
355361
let MilliGas costPerOneHundredBytes = _gasCostConfig_keccak256GasPerOneHundredBytes gasConfig
356362
MilliGas costPerChunk = _gasCostConfig_keccak256GasPerChunk gasConfig

src/Pact/Interpreter.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -282,7 +282,7 @@ pact411Natives :: [Text]
282282
pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-token-message"]
283283

284284
pact412Natives :: [Text]
285-
pact412Natives = ["hash-keccak256"]
285+
pact412Natives = ["hash-keccak256", "hyperlane-encode-token-message"]
286286

287287
initRefStore :: RefStore
288288
initRefStore = RefStore nativeDefs

src/Pact/Native.hs

Lines changed: 30 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,7 @@ import Pact.Types.Version
110110
import Pact.Types.Namespace
111111
import Crypto.Hash.Keccak256Native (Keccak256Error(..), keccak256)
112112
import Crypto.Hash.PoseidonNative (poseidon)
113-
import Crypto.Hash.HyperlaneNatives (hyperlaneMessageId, hyperlaneDecodeTokenMessage)
113+
import Crypto.Hash.HyperlaneNatives (hyperlaneMessageId, hyperlaneDecodeTokenMessage, hyperlaneEncodeTokenMessage)
114114

115115
import qualified Pact.JSON.Encode as J
116116

@@ -1624,6 +1624,7 @@ hyperlaneDefs :: NativeModule
16241624
hyperlaneDefs = ("Hyperlane",)
16251625
[ hyperlaneMessageIdDef
16261626
, hyperlaneDecodeTokenMessageDef
1627+
, hyperlaneEncodeTokenMessageDef
16271628
]
16281629

16291630
hyperlaneMessageIdDef :: NativeDef
@@ -1672,3 +1673,31 @@ hyperlaneDecodeTokenMessageDef =
16721673
Left err -> evalError' i err
16731674
Right term -> pure term
16741675
_ -> argsError i args
1676+
1677+
hyperlaneEncodeTokenMessageDef :: NativeDef
1678+
hyperlaneEncodeTokenMessageDef =
1679+
defGasRNative
1680+
"hyperlane-encode-token-message"
1681+
hyperlaneEncodeTokenMessageDef'
1682+
(funType tTyObjectAny [("x", tTyString)])
1683+
["(hyperlane-encode-token-message {recipient:GUARD, amount:DECIMAL, chainId:STRING})"]
1684+
"Encode an object into a base-64-unpadded encoded Hyperlane Token Message `AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA`."
1685+
where
1686+
hyperlaneEncodeTokenMessageDef' :: RNativeFun e
1687+
hyperlaneEncodeTokenMessageDef' i args = case args of
1688+
[TObject o _] ->
1689+
computeGas' i (GHyperlaneEncodeTokenMessage (BS.length (getRecipient o))) $
1690+
case hyperlaneEncodeTokenMessage o of
1691+
Left err -> evalError' i err
1692+
Right msg -> pure $ toTerm $ msg
1693+
_ -> argsError i args
1694+
1695+
getRecipient :: Object n -> BS.ByteString
1696+
getRecipient o =
1697+
let mRecipient = do
1698+
let om = _objectMap (_oObject o)
1699+
om ^? at "recipient" . _Just . _TLiteral . _1 . _LString
1700+
in
1701+
case mRecipient of
1702+
Nothing -> error "couldn't find recipient"
1703+
Just t -> T.encodeUtf8 t

src/Pact/Types/Gas.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -189,6 +189,9 @@ data GasArgs
189189
| GHyperlaneDecodeTokenMessage !Int
190190
-- ^ Cost of hyperlane-decode-token-message on this size (in bytes) of the
191191
-- hyperlane TokenMessage base64-encoded string.
192+
| GHyperlaneEncodeTokenMessage !Int
193+
-- ^ Cost of hyperlane-encode-token-message on this size (in bytes) of the
194+
-- hyperlane TokenMessage base64-encoded string.
192195
| GKeccak256 !(V.Vector Int)
193196
-- ^ Cost of hash-keccak256 given the number of bytes in each chunk.
194197

@@ -261,6 +264,7 @@ instance Pretty GasArgs where
261264
GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len
262265
GHyperlaneMessageId len -> "GHyperlaneMessageId:" <> pretty len
263266
GHyperlaneDecodeTokenMessage len -> "GHyperlaneDecodeTokenMessage:" <> pretty len
267+
GHyperlaneEncodeTokenMessage len -> "GHyperlaneEncodeTokenMessage:" <> pretty len
264268
GKeccak256 chunksBytes -> "GKeccak256:" <> pretty (V.toList chunksBytes)
265269

266270
newtype GasLimit = GasLimit ParsedInteger

tests/GasModelSpec.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ untestedNativesCheck = do
9292
, "list"
9393
, "continue"
9494
, "hyperlane-decode-token-message"
95+
, "hyperlane-encode-token-message"
9596
])
9697

9798
allGasTestsAndGoldenShouldPass :: Spec

tests/pact/hyperlane.repl

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,3 +35,7 @@
3535
(env-gas 0)
3636
(hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABfwgIHsgInByZWQiOiAia2V5cy1hbnkiLCAia2V5cyI6IFsgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiLCAiZGExYTMzOWJkODJkMmMyZTkxODA2MjZhMDBkYzA0MzI3NWRlYjNhYmFiYjI3YjU3MzhhYmY2YjlkY2VlOGRiNiIsICJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2IiwgImRhMWEzMzliZDgyZDJjMmU5MTgwNjI2YTAwZGMwNDMyNzVkZWIzYWJhYmIyN2I1NzM4YWJmNmI5ZGNlZThkYjYiIF0gfQAAAAA")
3737
(expect "Decoding a message with about 2000 characters should cost 3 gas" 3 (env-gas))
38+
39+
(env-gas 0)
40+
(hyperlane-encode-token-message {"amount": 599.0,"chainId": "1","recipient": "{\"pred\": \"keys-all\", \"keys\":[\"da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6\"]}"})
41+
(expect "Encoding a message with should cost 2 gas" 2 (env-gas))

0 commit comments

Comments
 (0)