diff --git a/src/Crypto/Hash/HyperlaneNatives.hs b/src/Crypto/Hash/HyperlaneNatives.hs index 7ef9b2708..38c02c22c 100644 --- a/src/Crypto/Hash/HyperlaneNatives.hs +++ b/src/Crypto/Hash/HyperlaneNatives.hs @@ -71,9 +71,13 @@ hyperlaneMessageId o = case decodeHyperlaneMessageObject o of hyperlaneDecodeTokenMessage :: Text -> Either Doc (Term Name) hyperlaneDecodeTokenMessage i = do tm <- first displayHyperlaneDecodeError $ do + -- We do not need to handle historical b64 error message shimming + -- or decoding from non-canonical strings in this base-64 decoder, + -- because this native is added in a Pact version that later than when + -- we moved to base64-bytestring >= 1.0, which behaves succeeds and + -- fails in exactly the cases we expect. + -- (The only change we make to its output is to strip error messages). 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 @@ -144,6 +148,19 @@ packHyperlaneMessage (HyperlaneMessage{..}) = <> BB.byteString (padLeft hmRecipient) <> packTokenMessageERC20 hmTokenMessage +{- +putHyperlaneMessage :: HyperlaneMessage -> Put +putHyperlaneMessage (HyperlaneMessage {..}) = do + putWord8 hmVersion + putWord32be hmNonce + putWord32be hmOriginDomain + putRawByteString (padLeft hmSender) + putWord32be hmDestinationDomain + putRawByteString (padLeft hmRecipient) + + putTokenMessageERC20 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 @@ -245,7 +262,7 @@ decodeHyperlaneMessageObject o = do hmVersion <- grabInt @Word8 om "version" hmNonce <- grabInt @Word32 om "nonce" hmOriginDomain <- grabInt @Word32 om "originDomain" - hmSender <- Text.encodeUtf8 <$> grabField om "sender" _LString + hmSender <- decodeHex =<< grabField om "sender" _LString hmDestinationDomain <- grabInt @Word32 om "destinationDomain" hmRecipient <- decodeHex =<< grabField om "recipient" _LString @@ -331,7 +348,6 @@ 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/src/Pact/Native.hs b/src/Pact/Native.hs index 970ade159..ab5b0eba9 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1666,14 +1666,7 @@ hyperlaneDecodeTokenMessageDef = where hyperlaneDecodeTokenMessageDef' :: RNativeFun e hyperlaneDecodeTokenMessageDef' i args = case args of - [TLitString msg] -> - -- We do not need to handle historical b64 error message shimming - -- or decoding from non-canonical strings in this base-64 decoder, - -- because this native is added in a Pact version that later than when - -- we moved to base64-bytestring >= 1.0, which behaves succeeds and - -- fails in exactly the cases we expect. - -- (The only change we make to its output is to strip error messages). computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $ case hyperlaneDecodeTokenMessage msg of Left err -> evalError' i err diff --git a/tests/HyperlaneSpec.hs b/tests/HyperlaneSpec.hs index 64db79a8b..c27005fb4 100644 --- a/tests/HyperlaneSpec.hs +++ b/tests/HyperlaneSpec.hs @@ -3,28 +3,25 @@ {-# 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) +import Data.ByteString.Base16 qualified as Base16 +import Data.ByteString.Builder qualified as BB +import Data.ByteString.Lazy qualified as BL import Data.Default (def) +import Data.Either (fromRight) import Data.Map (Map) import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe) 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) +import Test.Hspec referenceObject :: Object n referenceObject = mkObject @@ -76,7 +73,6 @@ spec = describe "hyperlane" $ do 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