fix decodeHyperlaneMessageObject

kadena-io · Apr 16, 2024 · c6efe69 · c6efe69
1 parent 85301ef
commit c6efe69
Show file tree

Hide file tree

Showing 4 changed files with 69 additions and 127 deletions.
diff --git a/src/Crypto/Hash/HyperlaneNatives.hs b/src/Crypto/Hash/HyperlaneNatives.hs
@@ -14,7 +14,6 @@ module Crypto.Hash.HyperlaneNatives
   ( HyperlaneMessage(..)
   , TokenMessageERC20(..)
   , decodeHyperlaneMessageObject
-  , decodeTokenMessageERC20
   , packHyperlaneMessage
   , packTokenMessageERC20
   , unpackTokenMessageERC20
@@ -53,7 +52,7 @@ import Pact.JSON.Decode qualified as J
 import Pact.Types.Exp (Literal(..))
 import Pact.Types.PactValue (PactValue(PGuard), fromPactValue)
 import Pact.Types.Pretty (Doc, pretty)
-import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Type(TyAny), _TLiteral, _TObject, _LDecimal, _LInteger, _LString, toTObject, ChainId(..))
+import Pact.Types.Runtime (Object(..), ObjectMap(..), FieldKey, Name, Type(TyAny), _TLiteral, _LInteger, _LString, toTObject, ChainId(..))
 import Pact.Types.Term (Term(..), toTerm)
 import Pact.Types.Util (decodeBase64UrlUnpadded)
 
@@ -100,14 +99,20 @@ data HyperlaneMessageIdError
     -- ^ Hex textual fields (usually ETH addresses) must be prefixed with "0x"
   | HyperlaneMessageIdErrorInvalidHex FieldKey
     -- ^ Invalid Hex. We discard error messages from base16-bytestring to
-    --   avoid unintentionally forking behaviour.
+  | HyperlaneMessageIdInvalidBase64 FieldKey
+    -- ^ Invalid base64 text field.
+  | HyperlaneMessageIdIncorrectSize FieldKey Int Int
+    -- ^ Invalid Hex. We discard error messages from base16-bytestring to
 
 displayHyperlaneMessageIdError :: HyperlaneMessageIdError -> Doc
 displayHyperlaneMessageIdError = \case
   HyperlaneMessageIdErrorFailedToFindKey key -> "Failed to find key in object: " <> pretty key
   HyperlaneMessageIdErrorNumberOutOfBounds key -> "Object key " <> pretty key <> " was out of bounds"
   HyperlaneMessageIdErrorBadHexPrefix key -> "Missing 0x prefix on field " <> pretty key
   HyperlaneMessageIdErrorInvalidHex key -> "Invalid hex encoding on field " <> pretty key
+  HyperlaneMessageIdInvalidBase64 key -> "Invalid base64 encoding on field " <> pretty key
+  HyperlaneMessageIdIncorrectSize key expected actual ->
+    "Incorrect binary data size " <> pretty key <> ". Expected: " <> pretty expected <> ", but got " <> pretty actual
 
 data HyperlaneDecodeError
   = HyperlaneDecodeErrorBase64
@@ -141,7 +146,7 @@ data HyperlaneMessage = HyperlaneMessage
   , hmSender :: ByteString -- 32x uint8
   , hmDestinationDomain :: Word32 -- uint32
   , hmRecipient :: ByteString -- 32x uint8
-  , hmTokenMessage :: TokenMessageERC20 -- variable
+  , hmMessageBody :: ByteString -- variable
   }
   deriving stock (Eq, Show)
 
@@ -161,10 +166,10 @@ packHyperlaneMessage (HyperlaneMessage{..}) =
      BB.word8 hmVersion
   <> BB.word32BE hmNonce
   <> BB.word32BE hmOriginDomain
-  <> BB.byteString (padLeft hmSender)
+  <> BB.byteString hmSender
   <> BB.word32BE hmDestinationDomain
-  <> BB.byteString (padLeft hmRecipient)
-  <> packTokenMessageERC20 hmTokenMessage
+  <> BB.byteString hmRecipient
+  <> BB.byteString hmMessageBody
 
 -- types shorter than 32 bytes are concatenated directly, without padding or sign extension
 -- dynamic types are encoded in-place and without the length.
@@ -251,13 +256,18 @@ keccak256Hash = BSS.fromShort . _getBytesN . _getKeccak256Hash . keccak256
 encodeHex :: ByteString -> Text
 encodeHex b = "0x" <> Text.decodeUtf8 (Base16.encode b)
 
-decodeHex :: FieldKey -> Text -> Either HyperlaneMessageIdError ByteString
-decodeHex key s = do
-  case Text.stripPrefix "0x" s of
-    Nothing -> do
-      throwError (HyperlaneMessageIdErrorBadHexPrefix key)
-    Just h -> do
-      first (const (HyperlaneMessageIdErrorInvalidHex key)) $ Base16.decode (Text.encodeUtf8 h)
+decodeBase64 :: FieldKey -> Text -> Either HyperlaneMessageIdError ByteString
+decodeBase64 key s =
+    first (const $ HyperlaneMessageIdInvalidBase64 key) $ decodeBase64UrlUnpadded $ Text.encodeUtf8 s
+
+decodeBase64AndValidate :: FieldKey -> Int -> Text -> Either HyperlaneMessageIdError ByteString
+decodeBase64AndValidate key expected s = do
+  decoded <- decodeBase64 key s
+
+  unless (BS.length decoded == expected) $
+    throwError $ HyperlaneMessageIdIncorrectSize key expected (BS.length decoded)
+
+  return decoded
 
 ----------------------------------------------
 --      Hyperlane Pact Object Decoding      --
@@ -270,33 +280,17 @@ decodeHyperlaneMessageObject o = do
   hmVersion           <- grabInt @Word8  om "version"
   hmNonce             <- grabInt @Word32 om "nonce"
   hmOriginDomain      <- grabInt @Word32 om "originDomain"
-  hmSender            <- decodeHex "sender" =<< grabField om "sender" _LString
+  hmSender            <- decodeBase64AndValidate "sender" 32 =<< grabField om "sender" _LString
   hmDestinationDomain <- grabInt @Word32 om "destinationDomain"
-  hmRecipient         <- decodeHex "recipient" =<< grabField om "recipient" _LString
-
-  let tokenObject = om ^? at "tokenMessage" . _Just . _TObject . _1
-  case tokenObject of
-    Nothing -> do
-      throwError (HyperlaneMessageIdErrorFailedToFindKey "tokenMessage")
-    Just tm -> do
-      hmTokenMessage <- decodeTokenMessageERC20 tm
-      pure HyperlaneMessage{..}
-
-decodeTokenMessageERC20 :: Object Name -> Either HyperlaneMessageIdError TokenMessageERC20
-decodeTokenMessageERC20 o = do
-  let om = _objectMap (_oObject o)
-  tmRecipient <- grabField om "recipient" _LString
-  tmAmount <- decimalToWord <$> grabField om "amount" _LDecimal
-  tmChainId <- grabInt @Word256 om "chainId"
-  pure $ TokenMessageERC20{..}
+  hmRecipient         <- decodeBase64AndValidate "recipient" 32 =<< grabField om "recipient" _LString
+  hmMessageBody       <- decodeBase64 "messageBody" =<< grabField om "messageBody" _LString
+
+  pure HyperlaneMessage{..}
 
 ----------------------------------------------
 --                Utilities                 --
 ----------------------------------------------
 
-decimalToWord :: Decimal -> Word256
-decimalToWord d = round (d * ethInWei)
-
 wordToDecimal :: Word256 -> Decimal
 wordToDecimal w = fromRational (toInteger w % ethInWei)
 
@@ -333,13 +327,6 @@ 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"
--- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NULhello world"
-padLeft :: ByteString -> ByteString
-padLeft s = BS.replicate (32 - BS.length s) 0 <> s
-
 -- | Pad with zeroes on the right, such that the resulting size is a multiple of 32.
 --
 -- > padRight "hello world"

diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs
@@ -1639,22 +1639,20 @@ hyperlaneMessageIdDef = defGasRNative
     hyperlaneMessageId' :: RNativeFun e
     hyperlaneMessageId' i args = case args of
       [TObject o _] ->
-        computeGas' i (GHyperlaneMessageId (BS.length (getTokenRecipient o))) $
+        computeGas' i (GHyperlaneMessageId (BS.length (getMessageBody o))) $
           case hyperlaneMessageId o of
             Left err -> evalError' i err
             Right msgId -> return $ toTerm msgId
       _ -> argsError i args
 
-    getTokenRecipient :: Object n -> BS.ByteString
-    getTokenRecipient o =
-      let mRecipient = do
+    getMessageBody :: Object n -> BS.ByteString
+    getMessageBody o =
+      let mBody = do
             let om = _objectMap (_oObject o)
-            tokenObject <- om ^? at "tokenMessage" . _Just . _TObject . _1
-            let tm = _objectMap (_oObject tokenObject)
-            tm ^? at "recipient" . _Just . _TLiteral . _1 . _LString
+            om ^? at "messageBody" . _Just . _TLiteral . _1 . _LString
       in
-      case mRecipient of
-        Nothing -> error "couldn't decode token recipient"
+      case mBody of
+        Nothing -> error "couldn't find message body"
         Just t -> T.encodeUtf8 t
 
 hyperlaneDecodeTokenMessageDef :: NativeDef

diff --git a/tests/HyperlaneSpec.hs b/tests/HyperlaneSpec.hs
@@ -8,24 +8,18 @@
 module HyperlaneSpec (spec) where
 
 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 Crypto.Hash.HyperlaneNatives (hyperlaneMessageId)
 import Data.Default (def)
-import Data.Either (fromRight)
 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, Name)
 import Pact.Types.Util (encodeBase64UrlUnpadded)
 import Test.Hspec
 
 data Reference = Reference
   { object :: Object Name
-  , tokenMessageText :: Text
   , messageId :: Text
   }
 
@@ -41,52 +35,13 @@ testRefs refs = describe "hyperlane" $ mapM_ (uncurry testRef) (zip [0..] refs)
           | Just message <- unwrapObject ref.object ^? at "message" . _Just . _TObject . _1 = message
           | otherwise = error "Extracting HyperlaneMessage Object failed"
 
-      let
-        hyperlaneMessage :: HyperlaneMessage
-        hyperlaneMessage = fromRight (error "Decoding reference hyperlane message failed") $ do
-          decodeHyperlaneMessageObject hyperlaneMessageObject
-
-      let
-        tokenMessage :: TokenMessageERC20
-        tokenMessage = hmTokenMessage hyperlaneMessage
-
-      it "TokenMessage encoding matches reference" $ do
-        let hexMessage = Text.decodeUtf8 (Base16.encode (BL.toStrict (BB.toLazyByteString (packTokenMessageERC20 tokenMessage))))
-        hexMessage `shouldBe` ref.tokenMessageText
-
       it "Computes the correct message id" $ do
         hyperlaneMessageId hyperlaneMessageObject `shouldBe` Right ref.messageId
 
-      it "TokenMessage decodes properly into a Pact Term" $ do
-        let input =
-                Text.decodeUtf8
-              . encodeBase64UrlUnpadded
-              . fromRight (error "base16 decoding error")
-              . Base16.decode
-              . Text.encodeUtf8
-              $ ref.tokenMessageText
-        hyperlaneDecodeTokenMessage input `shouldBe` tokenMessageToTerm tokenMessage
-
 spec :: Spec
 spec = testRefs
-  [ Reference
-      { object = mkObject
-          [ ("message",) $ obj
-              [ ("version", tLit $ LInteger 3)
-              , ("nonce", tLit $ LInteger 0)
-              , ("originDomain", tLit $ LInteger 31_337)
-              , ("sender", tStr $ asString ("0x000000000000000000000000c29f578e252f1a97fb3cbe4c3c570af74fa74405" :: Text))
-              , ("destinationDomain", tLit $ LInteger 626)
-              , ("recipient", tStr $ asString ("0x30472d564f4549754b6b4a723750756b434975464e306d5a4371644f5a695754" :: Text))
-              , ("tokenMessage", obj
-                  [ ("recipient", tStr $ asString ("{\"pred\":\"keys-all\",\"keys\":[\"e5db35973f544642cb8b1539cb8bdf039cfe11e5f7e1127a146bd2a6d13d28c4\"]}" :: Text))
-                  , ("amount", tLit $ LDecimal 20)
-                  , ("chainId", tLit $ LInteger 0)
-                  ]
-                )
-              ]
-          ]
-      , tokenMessageText = Text.concat
+  [ let
+    tokenMessageText = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ mconcat
           [ "0000000000000000000000000000000000000000000000000000000000000060" -- offset (decimal 96)
           , "000000000000000000000000000000000000000000000001158e460913d00000" -- amount
           , "0000000000000000000000000000000000000000000000000000000000000000" -- chainId
@@ -95,36 +50,43 @@ spec = testRefs
           , "3335393733663534343634326362386231353339636238626466303339636665" -- |
           , "31316535663765313132376131343662643261366431336432386334225d7d00" -- V
           ]
-      , messageId = "0xa5c3b3c117ed9f44f306bb1dfbc3d3d960a12b1394b54f44c2bd4056d0928108"
-      }
-  , Reference
+   in Reference
       { object = mkObject
           [ ("message",) $ obj
               [ ("version", tLit $ LInteger 3)
               , ("nonce", tLit $ LInteger 0)
               , ("originDomain", tLit $ LInteger 31_337)
-              , ("sender", tStr $ asString ("0x0000000000000000000000006171479a003d1d89915dd9e71657620313870283" :: Text))
+              , ("sender", tStr $ asString ("AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY" :: Text))
               , ("destinationDomain", tLit $ LInteger 626)
-              , ("recipient", tStr $ asString ("0x676a5f45557a44534f6e54497a4d72676c6e725f77584b56494454467a773465" :: Text))
-              , ("tokenMessage", obj
-                  --[ ("recipient", tStr $ asString ("{\"keys\":[\"94c35ab1bd70243ec670495077f7846373b4dc5e9779d7a6732b5ceb6fde059c\"],\"pred\":\"keys-all\"}" :: Text))
-                  [ ("recipient", tStr $ asString ("{\"pred\":\"keys-all\",\"keys\":[\"94c35ab1bd70243ec670495077f7846373b4dc5e9779d7a6732b5ceb6fde059c\"]}" :: Text))
-                  , ("amount", tLit $ LDecimal 0.5)
-                  , ("chainId", tLit $ LInteger 0)
-                  ]
-                )
+              , ("recipient", tStr $ asString ("AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU" :: Text))
+              , ("messageBody", tStr tokenMessageText)
               ]
           ]
-      , tokenMessageText = Text.concat
-          [ "0000000000000000000000000000000000000000000000000000000000000060" -- offset (decimal 96)
-          , "00000000000000000000000000000000000000000000000006f05b59d3b20000" -- amount
-          , "0000000000000000000000000000000000000000000000000000000000000000" -- chainId
-          , "000000000000000000000000000000000000000000000000000000000000005f" -- recipient length
-          , "7b2270726564223a226b6579732d616c6c222c226b657973223a5b2239346333" -- recipient
-          , "3561623162643730323433656336373034393530373766373834363337336234" -- |
-          , "64633565393737396437613637333262356365623666646530353963225d7d00" -- V
+      , messageId = "0x8a9ff9b92e972a0fe9b66806e4564d7c3879a97ac4e3eb4c8db34d3b85d8e4ad"
+      }
+  , let
+    tokenMessageText = Text.decodeUtf8 $ encodeBase64UrlUnpadded $ mconcat
+        [ "0000000000000000000000000000000000000000000000000000000000000060" -- offset (decimal 96)
+        , "00000000000000000000000000000000000000000000000006f05b59d3b20000" -- amount
+        , "0000000000000000000000000000000000000000000000000000000000000000" -- chainId
+        , "000000000000000000000000000000000000000000000000000000000000005f" -- recipient length
+        , "7b2270726564223a226b6579732d616c6c222c226b657973223a5b2239346333" -- recipient
+        , "3561623162643730323433656336373034393530373766373834363337336234" -- |
+        , "64633565393737396437613637333262356365623666646530353963225d7d00" -- V
+        ]
+  in Reference
+      { object = mkObject
+          [ ("message",) $ obj
+              [ ("version", tLit $ LInteger 3)
+              , ("nonce", tLit $ LInteger 0)
+              , ("originDomain", tLit $ LInteger 31_337)
+              , ("sender", tStr $ asString ("AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY" :: Text))
+              , ("destinationDomain", tLit $ LInteger 626)
+              , ("recipient", tStr $ asString ("AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU" :: Text))
+              , ("messageBody", tStr tokenMessageText)
+              ]
           ]
-      , messageId = "0x984831166082c9530bb0cc7293e9f99c9e6eb31729be11f20ca9cb72565e4aff"
+      , messageId = "0xbf63aed32b96d7bcdbc73a29c4e8d08f9b8bdb1cdaefc600a94b0404b6a5dfa3"
       }
   ]
 

diff --git a/tests/pact/hyperlane.repl b/tests/pact/hyperlane.repl
@@ -4,7 +4,7 @@
   { "test-keys" : {"pred": "keys-all", "keys": ["da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6"]}
   })
 
-(expect "computes the correct message id" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0x6b622d746f6b656e2d726f75746572","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1}))
+(expect "computes the correct message id" "0x3cbd30e222a483f3ad52191674b2f6951adb88636553d10f69a4a002ffd6c8d4" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "AAAAAAAAAADpgrOqkM0BOY-FQnNzkDXuYlsVcf50GRU","sender": "AAAAAAAAAAAAAAAAf6k4W-ECrD6sKXSD3WIz1is-FJY","messageBody": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","version": 1}))
 
 ; Decoding a valid TokenMessage should succeed.
 (expect "decodes the correct TokenMessage"
@@ -15,11 +15,6 @@
   (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
 )
 
-; Decoding a valid TokenMessage should succeed.
-(expect-failure "decoding fails for base64-padded messages"
-  (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==")
-)
-
 ; This TokenMessage was encoded with the recipient
 ; "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69".
 ; It should fail to decode because "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69"
@@ -33,7 +28,7 @@
 (env-gasmodel "table")
 (env-gaslimit 10000)
 
-(env-gas)
+(env-gas 0)
 (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
 (expect "Normal message decoding should cost 2 gas" 2 (env-gas))