Add a builtin for decoding TokenMessage for hyperlane SPI

pact.cabal

@@ -207,6 +207,7 @@ library
     , base >= 4.18.0.0
     , base16-bytestring >=0.1.1.6
     , base64-bytestring >=1.0.0.1
+    , binary
         -- base64-bytestring >=1.2.0.0 is less lenient then previous versions, which can cause pact failures (e.g. (env-hash "aa"))
     , bound >=2
     , bytestring >=0.10.8.1
@@ -220,6 +221,7 @@ library
     , deriving-compat >=0.5.1
     , direct-sqlite >=2.3.27
     , directory >=1.2.6.2
+    , data-dword
     , errors >=2.3
     , exceptions >=0.8.3
     , filepath >=1.4.1.0

src/Pact/Gas/Table.hs

@@ -56,6 +56,7 @@ data GasCostConfig = GasCostConfig
   , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas
   , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas
   , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas
+  , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes :: MilliGas
   }
 
 defaultGasConfig :: GasCostConfig
@@ -83,6 +84,7 @@ defaultGasConfig = GasCostConfig
   , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50
   , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38
   , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47
+  , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 1 -- TODO: Benchmark
   }
 
 defaultGasTable :: Map Text Gas
@@ -339,6 +341,9 @@ tableGasModel gasConfig =
         GHyperlaneMessageId len ->
           let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes gasConfig
           in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
+        GHyperlaneDecodeTokenMessage len ->
+          let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes gasConfig
+          in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
 
   in GasModel
       { gasModelName = "table"

src/Pact/Interpreter.hs

@@ -276,7 +276,7 @@ pact410Natives :: [Text]
 pact410Natives = ["poseidon-hash-hack-a-chain"]
 
 pact411Natives :: [Text]
-pact411Natives = ["enforce-verifier", "hyperlane-message-id"]
+pact411Natives = ["enforce-verifier", "hyperlane-message-id", "hyperlane-decode-tokenmessage"]
 
 initRefStore :: RefStore
 initRefStore = RefStore nativeDefs

src/Pact/Native.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE MultiWayIf #-}
 -- |
@@ -55,6 +56,7 @@ module Pact.Native
     , describeNamespaceSchema
     , dnUserGuard, dnAdminGuard, dnNamespaceName
     , cdPrevBlockHash
+    , encodeTokenMessage
     ) where
 
 import Control.Arrow hiding (app, first)
@@ -64,17 +66,24 @@ import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.Attoparsec.Text as AP
 import Data.Bifunctor (first)
+import Data.Binary.Get (Get, runGetOrFail, getWord64be, getByteString, isEmpty)
+import Data.Binary.Put (Put, runPut, putWord64be, putByteString)
 import Data.Bool (bool)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Base64.URL as B64URL
 import qualified Data.Char as Char
 import Data.Bits
+import Data.Decimal (Decimal)
 import Data.Default
+import Data.DoubleWord (Word128(..), Word256(..))
 import Data.Functor(($>))
 import Data.Foldable
+import Data.List (isPrefixOf)
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict as M
 import qualified Data.List as L (nubBy)
+import Data.Ratio ((%))
 import qualified Data.Set as S
 import Data.Text (Text, pack, unpack)
 import qualified Data.Text as T
@@ -111,6 +120,7 @@ import Crypto.Hash.PoseidonNative (poseidon)
 import Crypto.Hash.HyperlaneMessageId (hyperlaneMessageId)
 
 import qualified Pact.JSON.Encode as J
+import qualified Pact.JSON.Decode as J
 
 -- | All production native modules.
 natives :: [NativeModule]
@@ -1579,6 +1589,7 @@ poseidonHackAChainDef = defGasRNative
 hyperlaneDefs :: NativeModule
 hyperlaneDefs = ("Hyperlane",)
   [ hyperlaneMessageIdDef
+  , hyperlaneDecodeTokenMessageDef
   ]
 
 hyperlaneMessageIdDef :: NativeDef
@@ -1609,3 +1620,121 @@ hyperlaneMessageIdDef = defGasRNative
       case mRecipient of
         Nothing -> error "couldn't decode token recipient"
         Just t -> T.encodeUtf8 t
+
+hyperlaneDecodeTokenMessageDef :: NativeDef
+hyperlaneDecodeTokenMessageDef =
+  defGasRNative
+    "hyperlane-decode-tokenmessage"
+    hyperlaneDecodeTokenMessageDef'
+    (funType tTyObjectAny [("x", tTyString)])
+    ["(TODO example)"]
+    "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:STRING, amount:DECIMAL, chainId:STRING}`."
+  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 latre 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).
+        -- TODO: standard alphabet, or URL?
+        computeGas' i (GHyperlaneDecodeTokenMessage (T.length msg)) $
+          case B64URL.decode (T.encodeUtf8 msg) of
+            Left _ -> evalError' i "Failed to base64-decode token message"
+            Right bytes -> do
+              case runGetOrFail (getTokenMessageERC20 <* eof) (BS.fromStrict bytes) of
+                -- In case of Binary decoding failure, emit a terse error message.
+                -- If the error message begins with TokenError, we know that we
+                -- created it, and it is going to be stable (non-forking).
+                -- If it does not start with TokenMessage, it may have come from
+                -- the Binary library, and we will suppress it to shield ourselves
+                -- from forking behavior if we update our Binary version.
+                -- (TODO: Do we suppress error messages on-chain anyway?)
+                Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e
+                Left _ -> evalError' i "Decoding error: binary decoding failed" 
+                -- TODO: Do we need to assert that the bytes are fully consumed
+                -- by parsing?
+                -- TODO: Is this format correct? I.e. field names?
+                Right (_,_,(amount, chain, recipient)) ->
+                  case PGuard <$> J.eitherDecode (BS.fromStrict  $ T.encodeUtf8 recipient) of
+                    Left _ -> evalError' i $ "Could not parse recipient into a guard"
+                    Right g ->
+                      pure $ toTObject TyAny def
+                        [("recipient", fromPactValue g)
+                        ,("amount", TLiteral (LDecimal $ wordToDecimal amount) def)
+                        ,("chainId", toTerm chain)
+                        ]
+      _ -> argsError i args
+
+    -- The TokenMessage contains a recipient (text) and an amount (word-256).
+    getTokenMessageERC20 :: Get (Word256, ChainId, Text)
+    getTokenMessageERC20 = do
+
+      -- Parse the size of the following amount field.
+      amountSize <- fromIntegral @Word256 @Int <$> getWord256be
+      unless (amountSize == 96)
+        (fail $ "TokenMessage amountSize expected 96, found " ++ show amountSize)
+      tmAmount <- getWord256be
+      tmChainId <- getWord256be
+
+      recipientSize <- getWord256be
+      tmRecipient <- T.decodeUtf8 <$> getRecipient recipientSize
+
+      return (tmAmount, ChainId { _chainId = T.pack (show (toInteger tmChainId))}, tmRecipient)
+      where
+        getWord256be = Word256 <$> getWord128be <*> getWord128be
+        getWord128be = Word128 <$> getWord64be <*> getWord64be
+
+        -- TODO: We check the size. Is this ok?
+        -- | Reads a given number of bytes and the rest because binary data padded up to 32 bytes.
+        getRecipient :: Word256 -> Get BS.ByteString
+        getRecipient size = do
+          recipient <- BS.take (fromIntegral size) <$> getByteString (fromIntegral $ size + restSize size)
+          if BS.length recipient < fromIntegral size
+            then fail "TokenMessage recipient was smaller than expected"
+            else pure recipient
+
+
+    wordToDecimal :: Word256 -> Decimal
+    wordToDecimal w =
+      let ethInWei = 1000000000000000000 -- 1e18
+      in fromRational (toInteger w % ethInWei)
+
+    eof :: Get ()
+    eof = do
+      done <- isEmpty
+      unless done $ fail "pending bytes in input"
+
+-- | Helper function for creating TokenMessages encoded in the ERC20 format
+--   and base64url encoded. Used for generating test data.
+encodeTokenMessage :: BS.ByteString -> Word256 -> Word256 -> Text
+encodeTokenMessage recipient amount chain = T.decodeUtf8 $ B64URL.encode (BS.toStrict bytes)
+  where
+    bytes = runPut $ do
+      putWord256be (96 :: Word256)
+      putWord256be amount
+      putWord256be chain
+      putWord256be recipientSize
+      putByteString recipientBytes
+
+    (recipientBytes, recipientSize) = padRight recipient
+
+    putWord256be :: Word256 -> Put
+    putWord256be (Word256 x y) = putWord128be x >> putWord128be y
+
+    putWord128be :: Word128 -> Put
+    putWord128be (Word128 x y) = putWord64be x >> putWord64be y
+
+padRight :: BS.ByteString -> (BS.ByteString, Word256)
+padRight s =
+  let
+    size = BS.length s
+    missingZeroes = restSize size
+  in (s <> BS.replicate missingZeroes 0, fromIntegral size)
+
+-- | Returns the modular of 32 bytes.
+restSize :: Integral a => a -> a
+restSize size = (32 - size) `mod` 32

src/Pact/Types/Gas.hs

@@ -186,6 +186,9 @@ data GasArgs
   -- ^ Cost of the hyperlane-message-id on this size (in bytes) of the
   --   hyperlane TokenMessage Recipient, which is the only variable-length
   --   part of a HyperlaneMessage
+  | GHyperlaneDecodeTokenMessage !Int
+  -- ^ Cost of hyperlane-decode-tokenmessage on this size (in bytes) of the
+  --   hyperlane TokenMessage base64-encoded string.
 
 data IntOpThreshold
   = Pact43IntThreshold
@@ -255,6 +258,7 @@ instance Pretty GasArgs where
     GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args)
     GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len
     GHyperlaneMessageId len -> "GHyperlaneMessageId:" <> pretty len
+    GHyperlaneDecodeTokenMessage len -> "GHyperlaneDecodeTokenMessage:" <> pretty len
 
 newtype GasLimit = GasLimit ParsedInteger
   deriving (Eq,Ord,Generic)

tests/pact/hyperlane.repl

@@ -0,0 +1,25 @@
+;; Test hyperlane builtins.
+
+(env-data
+  { "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}))
+
+; Decoding a valid TokenMessage should succeed.
+(expect "decodes the correct TokenMessage"
+  { "amount":0.000000000000000123,
+    "chainId": "4",
+    "recipient": (read-keyset 'test-keys)
+  }
+  (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==")
+)
+
+; This TokenMessage was encoded with the recipient
+; "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69".
+; It should fail to decode because "k:462e97a099987f55f6a2b52e7bfd52a36b4b5b470fed0816a3d9b26f9450ba69"
+; is a principal, not a guard. (Recipient must be a guard encoded in json).
+(expect-failure
+  "Decoding requires recipient to be a guard."
+  (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEJrOjQ2MmU5N2EwOTk5ODdmNTVmNmEyYjUyZTdiZmQ1MmEzNmI0YjViNDcwZmVkMDgxNmEzZDliMjZmOTQ1MGJhNjkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=")
+)