Add a builtin for decoding TokenMessage for hyperlane SPI

docs/en/pact-functions.md

@@ -5,14 +5,14 @@
 
 Constant denoting the ASCII charset
 
-Constant:
+Constant: 
   `CHARSET_ASCII:integer = 0`
 
 ### CHARSET_LATIN1 {#CHARSET_LATIN1}
 
 Constant denoting the Latin-1 charset ISO-8859-1
 
-Constant:
+Constant: 
   `CHARSET_LATIN1:integer = 1`
 
 ### at {#at}
@@ -765,7 +765,7 @@ Top level only: this function will fail if used in module code.
 
 Select rows from TABLE using QRY as a predicate with both key and value, and then accumulate results of the query in CONSUMER. Output is sorted by the ordering of keys.
 ```lisp
-(let*
+(let* 
  ((qry (lambda (k obj) true)) ;; select all rows
   (f (lambda (k obj) [(at 'firstName obj), (at 'b obj)]))
  )
@@ -924,7 +924,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") 15)
 *n* `integer` *→* `decimal`
 
 
-N days, for use with 'add-time'
+N days, for use with 'add-time' 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (days 1))
 "2016-07-23T12:00:00Z"
@@ -962,7 +962,7 @@ pact> (format-time "%F" (time "2016-07-22T12:00:00Z"))
 *n* `integer` *→* `decimal`
 
 
-N hours, for use with 'add-time'
+N hours, for use with 'add-time' 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1))
 "2016-07-22T13:00:00Z"
@@ -976,7 +976,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1))
 *n* `integer` *→* `decimal`
 
 
-N minutes, for use with 'add-time'.
+N minutes, for use with 'add-time'. 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (minutes 1))
 "2016-07-22T12:01:00Z"
@@ -1000,7 +1000,7 @@ pact> (parse-time "%F" "2016-09-12")
 *utcval* `string` *→* `time`
 
 
-Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ).
+Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ). 
 ```lisp
 pact> (time "2016-07-22T11:26:35Z")
 "2016-07-22T11:26:35Z"
@@ -1817,6 +1817,18 @@ pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8)
 
 ## Hyperlane {#Hyperlane}
 
+### hyperlane-decode-tokenmessage {#hyperlane-decode-tokenmessage}
+
+*x* `string` *→* `object:*`
+
+
+Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`.
+```lisp
+pact> (hyperlane-decode-tokenmessage "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==")
+{"amount": 0.000000000000000123,"chainId": "4","recipient": KeySet {keys: [da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6],pred: keys-all}}
+```
+
+
 ### hyperlane-message-id {#hyperlane-message-id}
 
 *x* `object:*` *→* `string`

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

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 50
   }
 
 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,22 +66,30 @@ import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.Attoparsec.Text as AP
 import Data.Bifunctor (first)
+import Data.Binary (get, put)
+import Data.Binary.Get (Get, runGetOrFail, getByteString, isEmpty)
+import Data.Binary.Put (Put, runPut, 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.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
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as T
+import Data.WideWord.Word256
 import Pact.Time
 import qualified Data.Vector as V
 import qualified Data.Vector.Algorithms.Intro as V
@@ -111,6 +121,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 +1590,7 @@ poseidonHackAChainDef = defGasRNative
 hyperlaneDefs :: NativeModule
 hyperlaneDefs = ("Hyperlane",)
   [ hyperlaneMessageIdDef
+  , hyperlaneDecodeTokenMessageDef
   ]
 
 hyperlaneMessageIdDef :: NativeDef
@@ -1609,3 +1621,112 @@ 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)])
+    ["(hyperlane-decode-tokenmessage \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\")"]
+    "Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, 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 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 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.
+                Left (_,_,e) | "TokenMessage" `isPrefixOf` e -> evalError' i $ "Decoding error: " <> pretty e
+                Left _ -> evalError' i "Decoding error: binary decoding failed" 
+                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 = get @Word256
+
+        -- 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  = put @Word256
+
+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/GasModelSpec.hs

@@ -91,6 +91,7 @@ untestedNativesCheck = do
      , "dec"
      , "list"
      , "continue"
+     , "hyperlane-decode-tokenmessage"
      ])
 
 allGasTestsAndGoldenShouldPass :: Spec
@@ -144,7 +145,7 @@ allNativesInGasTable = do
         absentNatives = foldl' absent [] justNatives
     (S.fromList absentNatives)
     `shouldBe`
-    (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "public-chain-data", "list"])
+    (S.fromList ["CHARSET_ASCII", "CHARSET_LATIN1", "hyperlane-decode-tokenmessage", "public-chain-data", "list"])
 
 -- | Use this to run a single named test.
 _runNative :: NativeDefName -> IO (Maybe [(T.Text,Gas)])

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=")
+)