Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix hyperlane types #1358

Closed
wants to merge 6 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/Pact/GasModel/GasTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,8 @@ import Pact.JSON.Legacy.Value

-- | Gas benchmark tests for Pact native functions
allNatives :: [NativeDefName]
allNatives = map fst (concatMap snd natives) <> nonNatives
allNatives = map fst (concatMap snd pact412Natives) <> nonNatives


-- | Non-native concepts to benchmark
nonNatives :: [NativeDefName]
Expand Down
6 changes: 4 additions & 2 deletions src/Pact/Interpreter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ import System.Directory

import Pact.Compile
import Pact.Eval
import Pact.Native (nativeDefs)
import Pact.Native (nativeDefs, pact412NativeDefs)
import qualified Pact.Persist.Pure as Pure
import qualified Pact.Persist.SQLite as PSL
import Pact.PersistPactDb
Expand Down Expand Up @@ -288,7 +288,9 @@ initRefStore :: RefStore
initRefStore = RefStore nativeDefs

versionedNativesRefStore :: ExecutionConfig -> RefStore
versionedNativesRefStore ec = versionNatives initRefStore
versionedNativesRefStore ec@(ExecutionConfig s)
| S.member FlagDisablePact412 s = versionNatives (RefStore nativeDefs)
| otherwise = versionNatives (RefStore pact412NativeDefs)
where
versionNatives = appEndo $ mconcat
[ disablePact40Natives ec
Expand Down
53 changes: 44 additions & 9 deletions src/Pact/Native.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,10 @@
module Pact.Native
( natives
, nativeDefs
, hyperlaneDefs
, hyperlaneAmendedDefs
, pact412Natives
, pact412NativeDefs
, moduleToMap
, distinctDef
, enforceDef
Expand Down Expand Up @@ -138,13 +142,18 @@ natives =
, guardDefs
, zkDefs
, hashDefs
, hyperlaneDefs
]

-- | Production native modules as a dispatch map.
nativeDefs :: HM.HashMap Text Ref
nativeDefs = mconcat $ map moduleToMap natives

pact412Natives :: [NativeModule]
pact412Natives = hyperlaneAmendedDefs:natives

pact412NativeDefs :: HM.HashMap Text Ref
pact412NativeDefs = foldMap moduleToMap pact412Natives

moduleToMap :: NativeModule -> HM.HashMap Text Ref
moduleToMap = HM.fromList . map (asString *** Direct) . snd

Expand Down Expand Up @@ -1632,15 +1641,41 @@ keccak256Def = defGasRNative

hyperlaneDefs :: NativeModule
hyperlaneDefs = ("Hyperlane",)
[ hyperlaneMessageIdDef
, hyperlaneDecodeTokenMessageDef
[ hyperlaneMessageIdDef TyAny
, hyperlaneDecodeTokenMessageDef TyAny
]

hyperlaneAmendedDefs :: NativeModule
hyperlaneAmendedDefs = ("Hyperlane",)
[ hyperlaneMessageIdDef (TyUser (snd hyperlaneDataSchema))
, hyperlaneDecodeTokenMessageDef (TyUser (snd hyperlaneDataSchema))
, tokenMessageERC20Schema
, hyperlaneDataSchema
jmcardon marked this conversation as resolved.
Show resolved Hide resolved
]

hyperlaneMessageIdDef :: NativeDef
hyperlaneMessageIdDef = defGasRNative
tokenMessageERC20Schema :: NativeDef
tokenMessageERC20Schema = defSchema "hyperlane-token-erc20"
"Schema type for ERC20 TokenMessage"
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What kind of TokenMessage are we referring to here? If it's hyperlane specific it needs to mention this in the docs.

[(FieldKey "recipient", tTyString)
,(FieldKey "amount", tTyInteger)]

hyperlaneDataSchema :: NativeDef
hyperlaneDataSchema = defSchema "hyperlane-token-msg"
"Schema type for hyperlane messages"
[ (FieldKey "version", tTyInteger)
, (FieldKey "nonce", tTyInteger)
, (FieldKey "originDomain", tTyInteger)
, (FieldKey "destinationDomain", tTyInteger)
, (FieldKey "recipient", tTyString)
, (FieldKey "tokenMessage", tTyObject (TyUser (snd tokenMessageERC20Schema)))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just to confirm @chessai or @edmundnoble should this or should this not contain a chainId field?

]


hyperlaneMessageIdDef :: Type (Term Name) -> NativeDef
hyperlaneMessageIdDef ty = defGasRNative
"hyperlane-message-id"
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This comment needs work.

hyperlaneMessageId'
(funType tTyString [("x", tTyObjectAny)])
(funType tTyString [("x", tTyObject ty)])
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nice trick.

[
"(hyperlane-message-id {\"destinationDomain\": 1,\"nonce\": 325,\"originDomain\": 626,\"recipient\": \"0x71C7656EC7ab88b098defB751B7401B5f6d8976F\",\"sender\": \"0x6b622d746f6b656e2d726f75746572\",\"tokenMessage\": {\"amount\": 10000000000000000000.0,\"recipient\": \"0x71C7656EC7ab88b098defB751B7401B5f6d8976F\"},\"version\": 1})"
]
Expand All @@ -1665,12 +1700,12 @@ hyperlaneMessageIdDef = defGasRNative
Nothing -> error "couldn't decode token recipient"
Just t -> T.encodeUtf8 t

hyperlaneDecodeTokenMessageDef :: NativeDef
hyperlaneDecodeTokenMessageDef =
hyperlaneDecodeTokenMessageDef :: Type (Term Name) -> NativeDef
hyperlaneDecodeTokenMessageDef schematy =
defGasRNative
"hyperlane-decode-token-message"
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

same here.

hyperlaneDecodeTokenMessageDef'
(funType tTyObjectAny [("x", tTyString)])
(funType (tTyObject schematy) [("x", tTyString)])
["(hyperlane-decode-token-message \"AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\")"]
"Decode a base-64-unpadded encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`."
where
Expand Down
7 changes: 4 additions & 3 deletions src/Pact/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,13 +84,13 @@ import Pact.Parse
import Pact.Eval
import Pact.Types.Pretty hiding (line)
import Pact.Types.Runtime
import Pact.Native
import Pact.Repl.Lib
import Pact.Types.Logger
import Pact.Types.SPV
import Pact.Repl.Types
import Pact.Gas
import Pact.JSON.Legacy.Value
import Pact.Interpreter(versionedNativesRefStore)

-- | for use in GHCI
repl :: IO (Either () (Term Name))
Expand Down Expand Up @@ -134,8 +134,9 @@ initEvalEnv ls = do
mv <- newMVar ls
gasRef <- newIORef mempty
warnRef <- newIORef mempty
let executionConfig = def
return $ EvalEnv
{ _eeRefStore = RefStore nativeDefs
{ _eeRefStore = versionedNativesRefStore executionConfig
, _eeMsgSigs = mempty
, _eeMsgVerifiers = mempty
, _eeMsgBody = toLegacyJson (A.Object mempty)
Expand All @@ -151,7 +152,7 @@ initEvalEnv ls = do
, _eeNamespacePolicy = permissiveNamespacePolicy
, _eeSPVSupport = spvs mv
, _eePublicData = def
, _eeExecutionConfig = def
, _eeExecutionConfig = executionConfig
, _eeAdvice = def
, _eeInRepl = True
, _eeWarnings = warnRef
Expand Down
9 changes: 6 additions & 3 deletions tests/GasModelSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -89,9 +89,10 @@ untestedNativesCheck = do
, "verify-spv"
, "public-chain-data"
, "dec"
, "hyperlane-decode-token-message"
, "hyperlane-token-erc20","hyperlane-token-msg"
, "list"
, "continue"
, "hyperlane-decode-token-message"
])

allGasTestsAndGoldenShouldPass :: Spec
Expand Down Expand Up @@ -138,14 +139,16 @@ goldenSizeOfPactValues = do
allNativesInGasTable :: Spec
allNativesInGasTable = do
it "all native functions should be in gas table" $ do
let justNatives = map (asString . fst) (concatMap snd natives)
let justNatives = map (asString . fst) (concatMap snd pact412Natives)
absent li name = case (Map.lookup name defaultGasTable) of
Nothing -> name : li
Just _ -> li
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-token-erc20", "hyperlane-token-msg"
,"public-chain-data", "list"])

-- | Use this to run a single named test.
_runNative :: NativeDefName -> IO (Maybe [(T.Text,Gas)])
Expand Down
Loading