more work

pact.cabal

@@ -443,6 +443,7 @@ test-suite hspec
     , trifecta
     , unordered-containers
     , vector
+    , wide-word >= 0.1
 
   other-modules:
     Blake2Spec

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,27 +121,56 @@ 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     --
 ----------------------------------------------
 
 packHyperlaneMessage :: HyperlaneMessage -> Builder
 packHyperlaneMessage (HyperlaneMessage{..}) =
-  BB.word8 hmVersion
+     BB.word8 hmVersion
   <> BB.word32BE hmNonce
   <> BB.word32BE hmOriginDomain
   <> BB.byteString (padLeft hmSender)
   <> BB.word32BE hmDestinationDomain
   <> 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)
     ]

tests/HyperlaneSpec.hs

@@ -3,21 +3,27 @@
 {-# 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.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