@@ -22,6 +22,7 @@ module Crypto.Hash.HyperlaneNatives
22
22
-- Implementation of natives
23
23
, hyperlaneMessageId
24
24
, hyperlaneDecodeTokenMessage
25
+ , hyperlaneEncodeTokenMessage
25
26
) where
26
27
27
28
import Control.Lens ((^?) , at , _Just , Prism' , _1 )
@@ -30,6 +31,7 @@ import Control.Monad.Except (throwError)
30
31
import Data.Bifunctor (first )
31
32
import Data.Binary.Get (Get )
32
33
import Data.Binary.Get qualified as Bin
34
+ import Data.Binary.Put qualified as Bin
33
35
import Data.ByteString (ByteString )
34
36
import Data.ByteString qualified as BS
35
37
import Data.ByteString.Base16 qualified as Base16
@@ -45,16 +47,17 @@ import Data.Ratio ((%))
45
47
import Data.Text (Text )
46
48
import Data.Text qualified as Text
47
49
import Data.Text.Encoding qualified as Text
50
+ import Data.Text.Read qualified as Text
48
51
import Data.WideWord.Word256 (Word256 (.. ))
49
52
import Data.Word (Word8 , Word32 )
50
53
import Ethereum.Misc (keccak256 , _getKeccak256Hash , _getBytesN )
51
54
import Pact.JSON.Decode qualified as J
52
55
import Pact.Types.Exp (Literal (.. ))
53
56
import Pact.Types.PactValue (PactValue (PGuard ), fromPactValue )
54
57
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 )
56
59
import Pact.Types.Term (Term (.. ), toTerm )
57
- import Pact.Types.Util (decodeBase64UrlUnpadded )
60
+ import Pact.Types.Util (decodeBase64UrlUnpadded , encodeBase64UrlUnpadded )
58
61
59
62
----------------------------------------------
60
63
-- Primitives --
@@ -85,6 +88,13 @@ hyperlaneDecodeTokenMessage i = do
85
88
pure tm
86
89
tokenMessageToTerm tm
87
90
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
+
88
98
----------------------------------------------
89
99
-- Error Types --
90
100
----------------------------------------------
@@ -103,6 +113,7 @@ data HyperlaneMessageIdError
103
113
-- ^ Invalid base64 text field.
104
114
| HyperlaneMessageIdIncorrectSize FieldKey Int Int
105
115
-- ^ Invalid Hex. We discard error messages from base16-bytestring to
116
+ | HyperlaneMessageIdErrorInvalidChainId Text
106
117
107
118
displayHyperlaneMessageIdError :: HyperlaneMessageIdError -> Doc
108
119
displayHyperlaneMessageIdError = \ case
@@ -113,6 +124,7 @@ displayHyperlaneMessageIdError = \case
113
124
HyperlaneMessageIdInvalidBase64 key -> " Invalid base64 encoding on field " <> pretty key
114
125
HyperlaneMessageIdIncorrectSize key expected actual ->
115
126
" Incorrect binary data size " <> pretty key <> " . Expected: " <> pretty expected <> " , but got " <> pretty actual
127
+ HyperlaneMessageIdErrorInvalidChainId msg -> " Failed to decode chainId " <> pretty msg
116
128
117
129
data HyperlaneDecodeError
118
130
= HyperlaneDecodeErrorBase64
@@ -269,9 +281,17 @@ decodeBase64AndValidate key expected s = do
269
281
270
282
return decoded
271
283
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
+ ------------------------------------------------------
275
295
276
296
decodeHyperlaneMessageObject :: Object Name -> Either HyperlaneMessageIdError HyperlaneMessage
277
297
decodeHyperlaneMessageObject o = do
@@ -287,13 +307,30 @@ decodeHyperlaneMessageObject o = do
287
307
288
308
pure HyperlaneMessage {.. }
289
309
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
+
290
324
----------------------------------------------
291
325
-- Utilities --
292
326
----------------------------------------------
293
327
294
328
wordToDecimal :: Word256 -> Decimal
295
329
wordToDecimal w = fromRational (toInteger w % ethInWei)
296
330
331
+ decimalToWord :: Decimal -> Word256
332
+ decimalToWord d = round $ d * ethInWei
333
+
297
334
ethInWei :: Num a => a
298
335
ethInWei = 1_000_000_000_000_000_000 -- 1e18
299
336
{-# inline ethInWei #-}
0 commit comments