Skip to content

Commit

Permalink
fix decodeHyperlaneMessageObject
Browse files Browse the repository at this point in the history
  • Loading branch information
Evgenii Akentev committed Apr 9, 2024
1 parent 85301ef commit 07ac8dc
Show file tree
Hide file tree
Showing 5 changed files with 56 additions and 73 deletions.
43 changes: 14 additions & 29 deletions src/Crypto/Hash/HyperlaneNatives.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,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, _LDecimal, _LInteger, _LString, toTObject, ChainId(..))
import Pact.Types.Term (Term(..), toTerm)
import Pact.Types.Util (decodeBase64UrlUnpadded)

Expand Down Expand Up @@ -100,14 +100,16 @@ 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.

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

data HyperlaneDecodeError
= HyperlaneDecodeErrorBase64
Expand Down Expand Up @@ -141,7 +143,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)

Expand All @@ -164,7 +166,7 @@ packHyperlaneMessage (HyperlaneMessage{..}) =
<> BB.byteString (padLeft hmSender)
<> BB.word32BE hmDestinationDomain
<> BB.byteString (padLeft hmRecipient)
<> packTokenMessageERC20 hmTokenMessage
<> 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.
Expand Down Expand Up @@ -251,13 +253,9 @@ 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

----------------------------------------------
-- Hyperlane Pact Object Decoding --
Expand All @@ -270,25 +268,12 @@ 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 <- decodeBase64 "sender" =<< 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 <- decodeBase64 "recipient" =<< grabField om "recipient" _LString
hmMessageBody <- decodeBase64 "messageBody" =<< grabField om "messageBody" _LString

pure HyperlaneMessage{..}

----------------------------------------------
-- Utilities --
Expand Down
16 changes: 7 additions & 9 deletions src/Pact/Native.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions tests/HyperlaneSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,8 +47,8 @@ testRefs refs = describe "hyperlane" $ mapM_ (uncurry testRef) (zip [0..] refs)
decodeHyperlaneMessageObject hyperlaneMessageObject

let
tokenMessage :: TokenMessageERC20
tokenMessage = hmTokenMessage hyperlaneMessage
messageBody :: ByteString
messageBody = hmMessageBody hyperlaneMessage

it "TokenMessage encoding matches reference" $ do
let hexMessage = Text.decodeUtf8 (Base16.encode (BL.toStrict (BB.toLazyByteString (packTokenMessageERC20 tokenMessage))))
Expand All @@ -75,7 +75,7 @@ spec = testRefs
[ ("version", tLit $ LInteger 3)
, ("nonce", tLit $ LInteger 0)
, ("originDomain", tLit $ LInteger 31_337)
, ("sender", tStr $ asString ("0x000000000000000000000000c29f578e252f1a97fb3cbe4c3c570af74fa74405" :: Text))
, ("sender", tStr $ asString ("0G-VOEIuKkJr7PukCIuFN0mZCqdOZiWT" :: Text))
, ("destinationDomain", tLit $ LInteger 626)
, ("recipient", tStr $ asString ("0x30472d564f4549754b6b4a723750756b434975464e306d5a4371644f5a695754" :: Text))
, ("tokenMessage", obj
Expand All @@ -95,15 +95,15 @@ spec = testRefs
, "3335393733663534343634326362386231353339636238626466303339636665" -- |
, "31316535663765313132376131343662643261366431336432386334225d7d00" -- V
]
, messageId = "0xa5c3b3c117ed9f44f306bb1dfbc3d3d960a12b1394b54f44c2bd4056d0928108"
, messageId = "0xed9e15c49c07a490e122396d6c0a71968cbd0270863f3e8e0d3f603e0295c94c"
}
, 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 ("0G-VOEIuKkJr7PukCIuFN0mZCqdOZiWT" :: Text))
, ("destinationDomain", tLit $ LInteger 626)
, ("recipient", tStr $ asString ("0x676a5f45557a44534f6e54497a4d72676c6e725f77584b56494454467a773465" :: Text))
, ("tokenMessage", obj
Expand Down
58 changes: 29 additions & 29 deletions tests/PactTests.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,38 +40,38 @@ import qualified CoverageSpec
main :: IO ()
main = hspec $ parallel $ do

describe "Blake2Spec" Blake2Spec.spec
describe "KeysetSpec" KeysetSpec.spec
describe "RoundTripSpec" RoundTripSpec.spec
describe "PrincipalSpec" PrincipalSpec.spec
describe "Test.Pact.Utils.LegacyValue" Test.Pact.Utils.LegacyValue.spec
describe "SizeOfSpec" SizeOfSpec.spec
describe "Test.Pact.Native.Pairing" Test.Pact.Native.Pairing.spec
describe "PactTestsSpec" PactTestsSpec.spec
describe "ParserSpec" ParserSpec.spec
describe "SignatureSpec" SignatureSpec.spec
describe "SchemeSpec" SchemeSpec.spec
describe "Test.Pact.Parse" Test.Pact.Parse.spec
-- describe "Blake2Spec" Blake2Spec.spec
-- describe "KeysetSpec" KeysetSpec.spec
-- describe "RoundTripSpec" RoundTripSpec.spec
-- describe "PrincipalSpec" PrincipalSpec.spec
-- describe "Test.Pact.Utils.LegacyValue" Test.Pact.Utils.LegacyValue.spec
-- describe "SizeOfSpec" SizeOfSpec.spec
-- describe "Test.Pact.Native.Pairing" Test.Pact.Native.Pairing.spec
-- describe "PactTestsSpec" PactTestsSpec.spec
-- describe "ParserSpec" ParserSpec.spec
-- describe "SignatureSpec" SignatureSpec.spec
-- describe "SchemeSpec" SchemeSpec.spec
-- describe "Test.Pact.Parse" Test.Pact.Parse.spec

#ifdef BUILD_TOOL

describe "AnalyzePropertiesSpec" AnalyzePropertiesSpec.spec
describe "AnalyzeSpec" AnalyzeSpec.spec
describe "ClientSpec" ClientSpec.spec
describe "DocgenSpec" DocgenSpec.spec
describe "GasModelSpec" GasModelSpec.spec
describe "GoldenSpec" GoldenSpec.spec
describe "HistoryServiceSpec" HistoryServiceSpec.spec
-- describe "AnalyzePropertiesSpec" AnalyzePropertiesSpec.spec
-- describe "AnalyzeSpec" AnalyzeSpec.spec
-- describe "ClientSpec" ClientSpec.spec
-- describe "DocgenSpec" DocgenSpec.spec
-- describe "GasModelSpec" GasModelSpec.spec
-- describe "GoldenSpec" GoldenSpec.spec
-- describe "HistoryServiceSpec" HistoryServiceSpec.spec
describe "HyperlaneSpec" HyperlaneSpec.spec
describe "Keccak256Spec" Keccak256Spec.spec
describe "PactContinuationSpec" PactContinuationSpec.spec
describe "PersistSpec" PersistSpec.spec
describe "RemoteVerifySpec" RemoteVerifySpec.spec
describe "TypecheckSpec" TypecheckSpec.spec
describe "PactCLISpec" PactCLISpec.spec
describe "ZkSpec" ZkSpec.spec
describe "ReplSpec" ReplSpec.spec
describe "PoseidonSpec" PoseidonSpec.spec
describe "CoverageSpec" CoverageSpec.spec
-- describe "Keccak256Spec" Keccak256Spec.spec
-- describe "PactContinuationSpec" PactContinuationSpec.spec
-- describe "PersistSpec" PersistSpec.spec
-- describe "RemoteVerifySpec" RemoteVerifySpec.spec
-- describe "TypecheckSpec" TypecheckSpec.spec
-- describe "PactCLISpec" PactCLISpec.spec
-- describe "ZkSpec" ZkSpec.spec
-- describe "ReplSpec" ReplSpec.spec
-- describe "PoseidonSpec" PoseidonSpec.spec
-- describe "CoverageSpec" CoverageSpec.spec

#endif
2 changes: 1 addition & 1 deletion tests/pact/hyperlane.repl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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" "0x97d98aa7fdb548f43c9be37aaea33fca79680247eb8396148f1df10e6e0adfb7" (hyperlane-message-id {"destinationDomain": 1,"nonce": 325,"originDomain": 626,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F","sender": "0G-VOEIuKkJr7PukCIuFN0mZCqdOZiWT","tokenMessage": {"amount": 10000000000000000000.0,"recipient": "0x71C7656EC7ab88b098defB751B7401B5f6d8976F"},"version": 1}))

; Decoding a valid TokenMessage should succeed.
(expect "decodes the correct TokenMessage"
Expand Down

0 comments on commit 07ac8dc

Please sign in to comment.