correct implementation of hyperlane-message-id

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)
     ]

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

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