From c5e5b1425df2b402fca3a0b242e3d074500da24a Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 2 Apr 2024 15:38:51 -0500 Subject: [PATCH] more work --- pact.cabal | 1 + src/Crypto/Hash/HyperlaneNatives.hs | 51 ++++++++++++++++++++++++----- tests/HyperlaneSpec.hs | 42 ++++++++++++++++++------ 3 files changed, 76 insertions(+), 18 deletions(-) diff --git a/pact.cabal b/pact.cabal index a10ce9863..d276b2d11 100644 --- a/pact.cabal +++ b/pact.cabal @@ -443,6 +443,7 @@ test-suite hspec , trifecta , unordered-containers , vector + , wide-word >= 0.1 other-modules: Blake2Spec diff --git a/src/Crypto/Hash/HyperlaneNatives.hs b/src/Crypto/Hash/HyperlaneNatives.hs index 8e9aea304..7ef9b2708 100644 --- a/src/Crypto/Hash/HyperlaneNatives.hs +++ b/src/Crypto/Hash/HyperlaneNatives.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} @@ -29,7 +30,6 @@ import Control.Lens ((^?), at, _Just, Prism', _1) import Control.Monad (guard, unless) import Control.Monad.Except (throwError) import Data.Bifunctor (first) -import Data.Binary qualified as Bin import Data.Binary.Get (Get) import Data.Binary.Get qualified as Bin import Data.ByteString (ByteString) @@ -72,6 +72,8 @@ hyperlaneDecodeTokenMessage :: Text -> Either Doc (Term Name) hyperlaneDecodeTokenMessage i = do tm <- first displayHyperlaneDecodeError $ do bytes <- first (const HyperlaneDecodeErrorBase64) $ decodeBase64UrlUnpadded (Text.encodeUtf8 i) + --let x = Bin.runGetOrFail getWord256BE (BL.fromStrict bytes) + --Left (HyperlaneDecodeErrorInternal (show x)) case Bin.runGetOrFail (unpackTokenMessageERC20 <* eof) (BL.fromStrict bytes) of Left (_, _, e) | "TokenMessage" `List.isPrefixOf` e -> do throwError $ HyperlaneDecodeErrorInternal e @@ -106,7 +108,6 @@ displayHyperlaneDecodeError = \case HyperlaneDecodeErrorBinary -> "Decoding error: binary decoding failed" HyperlaneDecodeErrorParseRecipient -> "Could not parse recipient into a guard" - ---------------------------------------------- -- Hyperlane Message Types -- ---------------------------------------------- @@ -120,12 +121,14 @@ data HyperlaneMessage = HyperlaneMessage , hmRecipient :: ByteString -- 32x uint8 , hmTokenMessage :: TokenMessageERC20 -- variable } + deriving stock (Eq, Show) data TokenMessageERC20 = TokenMessageERC20 { tmRecipient :: Text -- variable , tmAmount :: Word256 -- uint256 , tmChainId :: Word256 -- uint256 } + deriving stock (Eq, Show) ---------------------------------------------- -- Hyperlane Message Binary Encoding -- @@ -133,7 +136,7 @@ data TokenMessageERC20 = TokenMessageERC20 packHyperlaneMessage :: HyperlaneMessage -> Builder packHyperlaneMessage (HyperlaneMessage{..}) = - BB.word8 hmVersion + BB.word8 hmVersion <> BB.word32BE hmNonce <> BB.word32BE hmOriginDomain <> BB.byteString (padLeft hmSender) @@ -141,6 +144,33 @@ packHyperlaneMessage (HyperlaneMessage{..}) = <> BB.byteString (padLeft hmRecipient) <> packTokenMessageERC20 hmTokenMessage +-- types shorter than 32 bytes are concatenated directly, without padding or sign extension +-- dynamic types are encoded in-place and without the length. +-- array elements are padded, but still encoded in-place + +{- + function formatMessage( + uint8 _version, + uint32 _nonce, + uint32 _originDomain, + bytes32 _sender, + uint32 _destinationDomain, + bytes32 _recipient, + bytes calldata _messageBody + ) internal pure returns (bytes memory) { + return + abi.encodePacked( + _version, + _nonce, + _originDomain, + _sender, + _destinationDomain, + _recipient, + _messageBody + ); + } +-} + -- The TokenMessage contains a recipient (text) and an amount (word-256). -- A schematic of the message format: -- 0000000000000000000000000000000000000000000000000000000000000060 # offset of the recipient string = 96, because first three lines are 32 bytes each @@ -154,7 +184,7 @@ packHyperlaneMessage (HyperlaneMessage{..}) = packTokenMessageERC20 :: TokenMessageERC20 -> Builder packTokenMessageERC20 t = word256BE 96 - <> word256BE (tmAmount t) + <> word256BE (tmAmount t) --round (wordToDecimal (tmAmount t))) -- amount -- <> word256BE (tmChainId t) <> word256BE recipientSize <> BB.byteString recipient @@ -163,14 +193,14 @@ packTokenMessageERC20 t = unpackTokenMessageERC20 :: Get TokenMessageERC20 unpackTokenMessageERC20 = do - firstOffset <- Bin.get @Word256 + firstOffset <- getWord256BE unless (firstOffset == 96) $ do fail $ "TokenMessage firstOffset expected 96, found " ++ show firstOffset - tmAmount <- Bin.get @Word256 - tmChainId <- Bin.get @Word256 + tmAmount <- getWord256BE + tmChainId <- getWord256BE - recipientSize <- Bin.get @Word256 + recipientSize <- getWord256BE tmRecipient <- Text.decodeUtf8 <$> do let size = fromIntegral @Word256 @Int recipientSize recipient <- BS.take size @@ -268,6 +298,10 @@ word256BE :: Word256 -> Builder word256BE (Word256 a b c d) = BB.word64BE a <> BB.word64BE b <> BB.word64BE c <> BB.word64BE d +getWord256BE :: Get Word256 +getWord256BE = do + Word256 <$> Bin.getWord64be <*> Bin.getWord64be <*> Bin.getWord64be <*> Bin.getWord64be + -- | Pad with zeroes on the left to 32 bytes -- -- > padLeft "hello world" @@ -297,6 +331,7 @@ tokenMessageToTerm tm = first displayHyperlaneDecodeError $ do let chainId = ChainId { _chainId = Text.pack (show (toInteger (tmChainId tm))) } pure $ toTObject TyAny def [ ("recipient", fromPactValue g) + --, ("amount", TLiteral (LDecimal (fromRational (toInteger (tmAmount tm) % 1))) def) , ("amount", TLiteral (LDecimal (wordToDecimal (tmAmount tm))) def) , ("chainId", toTerm chainId) ] diff --git a/tests/HyperlaneSpec.hs b/tests/HyperlaneSpec.hs index f9ef7dd16..64db79a8b 100644 --- a/tests/HyperlaneSpec.hs +++ b/tests/HyperlaneSpec.hs @@ -3,9 +3,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module HyperlaneSpec (spec) where +import Data.Either (fromRight) +import Data.Decimal (Decimal) +import Data.WideWord.Word256 (Word256(..)) import Data.Maybe (fromMaybe) import Control.Lens ((^?), at, _Just, _1) import Crypto.Hash.HyperlaneNatives (HyperlaneMessage(..), TokenMessageERC20(..), decodeHyperlaneMessageObject, hyperlaneMessageId, hyperlaneDecodeTokenMessage, packTokenMessageERC20, tokenMessageToTerm) @@ -13,11 +17,13 @@ import Data.Default (def) import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) +import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Pact.Types.Runtime (FieldKey, Object(..), ObjectMap(..), Term, Literal(..), tLit, tStr, asString, toTObject, Type(..), _TObject) import Test.Hspec import Data.ByteString.Builder qualified as BB import Data.ByteString.Lazy qualified as BL +import Data.ByteString.Base16 qualified as Base16 import Pact.Types.Util (encodeBase64UrlUnpadded) referenceObject :: Object n @@ -31,7 +37,7 @@ referenceObject = mkObject , ("recipient", tStr $ asString ("0x30472d564f4549754b6b4a723750756b434975464e306d5a4371644f5a695754" :: Text)) , ("tokenMessage", obj [ ("recipient", tStr $ asString ("{\"pred\":\"keys-all\",\"keys\":[\"e5db35973f544642cb8b1539cb8bdf039cfe11e5f7e1127a146bd2a6d13d28c4\"]}" :: Text)) - , ("amount", tLit $ LDecimal 20_000_000_000_000_000_000) + , ("amount", tLit $ LDecimal 20) , ("chainId", tLit $ LInteger 0) ] ) @@ -50,15 +56,39 @@ referenceHyperlaneMessage = fromMaybe (error "Decoding reference hyperlane messa referenceTokenMessage :: TokenMessageERC20 referenceTokenMessage = hmTokenMessage referenceHyperlaneMessage +referenceTokenMessageText :: Text +referenceTokenMessageText = Text.concat + [ "0000000000000000000000000000000000000000000000000000000000000060" -- offset (decimal 96) + , "000000000000000000000000000000000000000000000001158e460913d00000" -- amount + , "0000000000000000000000000000000000000000000000000000000000000000" -- chainId + , "000000000000000000000000000000000000000000000000000000000000005f" -- recipient length + , "7b2270726564223a226b6579732d616c6c222c226b657973223a5b2265356462" -- recipient + , "3335393733663534343634326362386231353339636238626466303339636665" -- | + , "31316535663765313132376131343662643261366431336432386334225d7d00" -- V + ] + spec :: Spec spec = describe "hyperlane" $ do + describe "TokenMessage Encoding/Decoding" $ do + it "encodes to the correct bytes" $ do + let hexMessage = Text.decodeUtf8 (Base16.encode (BL.toStrict (BB.toLazyByteString (packTokenMessageERC20 referenceTokenMessage)))) + hexMessage `shouldBe` referenceTokenMessageText + describe "hyperlane-message-id" $ do it "computes the correct message id" $ do + print $ decodeHyperlaneMessageObject referenceHyperlaneMessageObject hyperlaneMessageId referenceHyperlaneMessageObject `shouldBe` "0xa5c3b3c117ed9f44f306bb1dfbc3d3d960a12b1394b54f44c2bd4056d0928108" describe "hyperlane-decode-token-message" $ do it "decodes the correct token message out" $ do - hyperlaneDecodeTokenMessage (tokenMessageToInput referenceTokenMessage) `shouldBe` tokenMessageToTerm referenceTokenMessage + let input = + Text.decodeUtf8 + . encodeBase64UrlUnpadded + . fromRight (error "base16 decoding error") + . Base16.decode + . Text.encodeUtf8 + $ referenceTokenMessageText + hyperlaneDecodeTokenMessage input `shouldBe` tokenMessageToTerm referenceTokenMessage mkObject :: [(FieldKey, Term n)] -> Object n mkObject ps = Object (ObjectMap (Map.fromList ps)) TyAny Nothing def @@ -68,11 +98,3 @@ obj = toTObject TyAny def unwrapObject :: Object n -> Map FieldKey (Term n) unwrapObject o = _objectMap (_oObject o) - -tokenMessageToInput :: TokenMessageERC20 -> Text -tokenMessageToInput = - Text.decodeUtf8 - . encodeBase64UrlUnpadded - . BL.toStrict - . BB.toLazyByteString - . packTokenMessageERC20