TestCore.daml

-- | Daml Script tests and devnet bootstrap for the Wormhole core bridge.
--
-- @setup@ is referenced by @daml.yaml@'s @init-script@ and seeds a devnet
-- operator + 'CoreState' with the standard Tilt/devnet guardian (address
-- 0xbeFA429d57cD18b7F8A4d91A2da9AB4AF05d0FBe).
module Test.TestCore where

import Daml.Script
import DA.Assert ((===))
import DA.Map qualified as Map
import DA.Optional (fromOptional, fromSome)
import Splice.Api.Token.HoldingV1 (InstrumentId(..))
import Wormhole.Core.Bytes
import Wormhole.Core.GuardianSet
import Wormhole.Core.State
import Wormhole.Core.Setup
import Wormhole.Core.VAA ()   -- HasField instances for VAA record-dot access

-- The well-known devnet guardian address used across Wormhole's Tilt setup.
devnetGuardian : Bytes20
devnetGuardian = "befa429d57cd18b7f8a4d91a2da9ab4af05d0fbe"

-- 65-byte uncompressed secp256k1 public key of the devnet guardian.
devnetGuardianPubKey : Bytes
devnetGuardianPubKey = "04d4a4629979f0c9fa0f0bb54edf33f87c8c5a1f42c0350a30d68f7e967023e34e495a8ebf5101036d0fd66e3b0a8c7c61b65fceeaf487ab3cd1b5b7b50beb7970"

-- A real governance VAA — SetMessageFee(chain=72, fee=1000), emitted by the
-- standard governance emitter (chain 1, 0x..04) and signed by the devnet
-- guardian (set 0). Generated by node/pkg/cantonclient/vectorgen_test.go.
govSetFeeVAA : Bytes
govSetFeeVAA = "01000000000100710ab5dcf6885f62016990540e090400f26f41286382dab479a78ed5f85017ff4a562a46379753e94abba1e69b9fec5d1994ac7d9fb145820727df0759bf4f80016553f100000000000001000000000000000000000000000000000000000000000000000000000000000400000000000000010000000000000000000000000000000000000000000000000000000000436f726503004800000000000000000000000000000000000000000000000000000000000003e8"

-- | Bootstrap a devnet 'CoreState', 'EmitterRegistry', and 'ReplayRootRegistry'.
-- The 'CoreState' is co-signed by @operator@ and @guardianGovernance@ (a single
-- party here; a k-of-n threshold party in production), so genesis needs both. It
-- allocates the read-only @guardianObserver@ and threads it into the 'CoreState'
-- and 'EmitterRegistry' (from which 'RegisterEmitter' carries it into each
-- 'Emitter'). Keeps @operator@ FIRST so bootstrap.sh's first-party extraction
-- still yields it.
setup : Script (Party, Party, ContractId CoreState)
setup = setupWithInstrument None

-- | 'setup' with a caller-supplied fee instrument (Test.TestFees provides a
-- mock-token instrument; plain 'setup' uses a placeholder that is never
-- validated because all fees default to 0). The fee recipient is
-- @guardianGovernance@, matching production custody.
setupWithInstrument : Optional InstrumentId -> Script (Party, Party, ContractId CoreState)
setupWithInstrument mInstrument = do
  operator <- allocateParty "Operator"
  guardianGovernance <- allocateParty "GuardianGovernance"
  guardianObserver <- allocateParty "GuardianObserver"
  let feeInstrument = fromOptional (InstrumentId with admin = guardianGovernance, id = "UNUSED") mInstrument
  csId <- submit (actAs operator <> actAs guardianGovernance) do
    createCmd (mkInitialCoreState operator guardianGovernance solanaGovernanceChainId
                 defaultGovernanceContract [devnetGuardian] guardianObserver
                 feeInstrument guardianGovernance)
  _ <- submit operator do createCmd (mkInitialEmitterRegistry operator guardianObserver 0)
  _ <- submit operator do createCmd (mkInitialReplayRootRegistry operator 0)
  pure (operator, guardianObserver, csId)

-- | Register an emitter for @owner@, the production way: the requester submits
-- alone against the disclosed 'EmitterRegistry' (served off-ledger by the
-- disclosure service — simulated here by querying as the operator); the
-- operator's co-signature on the 'Emitter' is inherited from the registry.
-- Zero-fee registries need no CoreState reference.
registerEmitter : Party -> Party -> Script (ContractId Emitter)
registerEmitter operator owner = do
  [(regCid, _)] <- query @EmitterRegistry operator
  regDisc <- fromSome <$> queryDisclosure operator regCid
  (_, emCid) <- submit (actAs owner <> disclose regDisc) do
    exerciseCmd regCid RegisterEmitter with
      requester = owner
      coreStateCid = None
      feeAllocation = None
  pure emCid

-- | Publish with the referenced 'CoreState' disclosed (the fee read is on
-- every publish; at fee 0 no allocation is attached). The disclosure is
-- fetched as the operator — the disclosure-service simulation.
publishVia : Party -> ContractId CoreState -> Party -> ContractId Emitter -> Int -> Bytes -> Int -> Script WormholeMessage
publishVia operator csId owner emCid nonce payload consistencyLevel = do
  csDisc <- fromSome <$> queryDisclosure operator csId
  submit (actAs owner <> disclose csDisc) do
    exerciseCmd emCid PublishMessage with
      nonce, payload, consistencyLevel
      coreStateCid = csId
      payer = owner
      feeAllocation = None

-- | Publishing increments the per-emitter sequence and yields the expected
-- 'WormholeMessage'. The message carries the emitter's identity components
-- (the watcher derives the 32-byte address as keccak256 over them); the second
-- publish resolves the sequence-bumped successor from the owner's own ACS —
-- the direct-cid model needs no off-ledger service for stakeholders.
testPublishMessage : Script ()
testPublishMessage = do
  (operator, _, csId) <- setup
  alice <- allocateParty "Alice"
  emitterId <- registerEmitter operator alice
  Some em <- queryContractId alice emitterId
  em.emitterId === 0
  em.emitterAddress === emitterAddressFor operator alice 0

  msg0 <- publishVia operator csId alice emitterId 7 "deadbeef" 0
  msg0.registrar === operator
  msg0.owner === alice
  msg0.emitterId === 0
  msg0.sequence === 0
  msg0.nonce === 7
  msg0.payload === "deadbeef"

  -- The sequence-bumped successor's cid arrives on the owner's ACS (the owner
  -- is a signatory), so the next publish addresses it directly.
  [(emitterId', _)] <- query @Emitter alice
  msg1 <- publishVia operator csId alice emitterId' 8 "cafe" 0
  msg1.sequence === 1
  msg1.registrar === operator
  msg1.owner === alice
  msg1.emitterId === 0
  pure ()

-- | Emitter ids are allocated sequentially and yield distinct, owner-bound
-- addresses; the registry's counter advances.
testRegistryAllocation : Script ()
testRegistryAllocation = do
  (operator, _, _) <- setup
  alice <- allocateParty "AllocAlice"
  bob <- allocateParty "AllocBob"
  aliceEm <- registerEmitter operator alice
  bobEm <- registerEmitter operator bob
  Some a <- queryContractId alice aliceEm
  Some b <- queryContractId bob bobEm
  a.emitterId === 0
  b.emitterId === 1
  assert (a.emitterAddress /= b.emitterAddress)
  [(_, reg)] <- query @EmitterRegistry operator
  reg.nextId === 2

-- | Pins the canonical emitter-address encoding against the cross-language test
-- vector (node/pkg/cantonclient/vectorgen_test.go TestGenerateAddressVectors and
-- pkg/watchers/canton/watcher_test.go). If this fails, the Daml and Go encoders
-- have diverged — fix BOTH and regenerate the vector.
testAddressVector : Script ()
testAddressVector =
  derivedAddressFromText
      (DomainTag emitterAddressTag)
      (RegistrarText "vector-operator::1220deadbeef")
      (OwnerText "vector-owner::1220cafebabe")
      (RegistryId 7)
    === "45ae8886d1c165b071d3b1202fe81ebedc39f61a6a91a1d13140eb64857f3f2b"

-- | A compromised operator cannot forge an existing emitter's address. The
-- address includes the @owner@, and the 'Emitter' is owner-co-signed, so:
--   (a) the operator alone cannot create a contract carrying the owner's address
--       (missing the owner's signature); and
--   (b) even colluding with another party, the best it can do is a contract with
--       a DIFFERENT owner, which derives a different (untrusted) address.
-- This is the invariant guardians verify by replay. Registry-id discipline is
-- behavioral — but address integrity is not.
testImpersonationBlocked : Script ()
testImpersonationBlocked = do
  (operator, guardianObserver, _) <- setup
  alice <- allocateParty "VictimAlice"
  mallory <- allocateParty "Mallory"
  aliceEm <- registerEmitter operator alice
  Some a <- queryContractId alice aliceEm

  -- (a) Operator-alone forgery of Alice's address is impossible.
  submitMustFail operator do
    createCmd Emitter with
      operator, owner = alice
      guardianObserver, emitterId = 0
      emitterAddress = a.emitterAddress, sequence = 0

  -- (b) Operator + Mallory can create a same-id emitter, but its address differs.
  malloryEm <- submit (actAs operator <> actAs mallory) do
    createCmd Emitter with
      operator, owner = mallory
      guardianObserver, emitterId = 0
      emitterAddress = emitterAddressFor operator mallory 0, sequence = 0
  Some m <- queryContractId mallory malloryEm
  assert (m.emitterAddress /= a.emitterAddress)

-- | Payloads larger than 750 bytes are rejected.
testPayloadTooLarge : Script ()
testPayloadTooLarge = do
  (operator, _, csId) <- setup
  bob <- allocateParty "Bob"
  emitterId <- registerEmitter operator bob
  csDisc <- fromSome <$> queryDisclosure operator csId
  -- 751 bytes = 1502 hex chars.
  let bigPayload = mconcat (replicate 1502 "f")
  submitMustFail (actAs bob <> disclose csDisc) do
    exerciseCmd emitterId PublishMessage with
      nonce = 0, payload = bigPayload, consistencyLevel = 0
      coreStateCid = csId, payer = bob, feeAllocation = None
  pure ()

-- | Sanity check on quorum thresholds (EVM parity: floor(n*2/3)+1).
testQuorum : Script ()
testQuorum = do
  quorum 1 === 1
  quorum 3 === 3
  quorum 4 === 3
  quorum 19 === 13
  pure ()

-- | The current guardian set is installed at index 0 and never expires.
testInitialGuardianSet : Script ()
testInitialGuardianSet = do
  (operator, _, csId) <- setup
  Some cs <- queryContractId operator csId
  cs.guardianSetIndex === 0
  let gs = fromSome (Map.lookup 0 cs.guardianSets)
  gs.keys === [devnetGuardian]
  gs.expirationTime === None

-- | On-chain VAA verification accepts a genuine guardian signature: parses the
-- VAA and verifies it against guardian set 0 (the devnet guardian). This
-- exercises the full keccak256 + DER + secp256k1WithEcdsaOnly path.
testParseAndVerifyVAA : Script ()
testParseAndVerifyVAA = do
  (operator, _, csId) <- setup
  vaa <- submit operator do
    exerciseCmd csId ParseAndVerifyVAA with
      verifier = operator
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]
  vaa.guardianSetIndex === 0
  vaa.emitterChain === 1
  vaa.sequence === 1

-- | ParseAndVerifyVAA is genuinely permissionless: an external party with no
-- relationship to CoreState (not operator or guardianGovernance, its only two
-- stakeholders) verifies a VAA as itself, given only CoreState disclosed to it
-- -- a data attachment, not an approval.
testParseAndVerifyVAAByExternalVerifier : Script ()
testParseAndVerifyVAAByExternalVerifier = do
  (operator, _, csId) <- setup
  tokenBridge <- allocateParty "ExternalTokenBridge"
  Some dCs <- queryDisclosure operator csId
  vaa <- submitWithDisclosures tokenBridge [dCs] do
    exerciseCmd csId ParseAndVerifyVAA with
      verifier = tokenBridge
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]
  vaa.guardianSetIndex === 0
  vaa.emitterChain === 1
  vaa.sequence === 1

-- | Integration entrypoint, invoked by the Go integration test via `dpm script`
-- against a live sandbox/participant. Same scenario as
-- 'testParseAndVerifyVAAByExternalVerifier'; returns the external verifier's
-- party id so the Go test can sanity-check it (a real, hosted party).
integrationParseAndVerifyVAAByExternalVerifier : Script Party
integrationParseAndVerifyVAAByExternalVerifier = do
  (operator, _, csId) <- setup
  tokenBridge <- allocateParty "IntegrationExternalVerifier"
  Some dCs <- queryDisclosure operator csId
  vaa <- submitWithDisclosures tokenBridge [dCs] do
    exerciseCmd csId ParseAndVerifyVAA with
      verifier = tokenBridge
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]
  vaa.guardianSetIndex === 0
  vaa.emitterChain === 1
  vaa.sequence === 1
  pure tokenBridge

-- | A SetMessageFee governance VAA verifies and updates the message fee. The
-- operator addresses the 'CoreState' by cid from its own ACS and submits alone
-- (guardianGovernance's authority is inherited from the archived contract).
testGovernanceSetMessageFee : Script ()
testGovernanceSetMessageFee = do
  (operator, _, csId) <- setup
  newCsId <- submit operator do
    exerciseCmd csId SubmitGovernanceVAA with
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]
  Some cs <- queryContractId operator newCsId
  cs.messageFee === 1000

-- | Governance replay protection (the 'consumedGovernance' set) still rejects
-- a resubmitted governance VAA.
testGovernanceReplayRejected : Script ()
testGovernanceReplayRejected = do
  (operator, _, csId) <- setup
  newCsId <- submit operator do
    exerciseCmd csId SubmitGovernanceVAA with
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]
  submitMustFail operator do
    exerciseCmd newCsId SubmitGovernanceVAA with
      encodedVAA = govSetFeeVAA
      pubKeys = [(0, devnetGuardianPubKey)]

-- | Integration entrypoint, invoked by the Go integration test via
-- `dpm script` (NOT by `dpm test`): set up the bridge, register an emitter,
-- publish one message (nonce 42, payload 0x11223344) by cid, and return the
-- Operator party so the watcher can read the ledger as it. The emitter address
-- is not chosen here: the watcher derives it from the message's identity
-- components, which the Go test recomputes.
integrationPublish : Script Party
integrationPublish = do
  (operator, _, csId) <- setup
  owner <- allocateParty "IntegrationEmitter"
  emId <- registerEmitter operator owner
  _ <- publishVia operator csId owner emId 42 "11223344" 0
  pure operator

-- | Exercise the auto-generated Archive choice on each template (for coverage).
testArchives : Script ()
testArchives = do
  (operator, _, csId) <- setup
  Some cs <- queryContractId operator csId
  -- CoreState is co-signed, so archiving needs operator + guardianGovernance.
  submit (actAs operator <> actAs cs.guardianGovernance) do archiveCmd csId
  bob <- allocateParty "ArchBob"
  emId <- registerEmitter operator bob
  -- Emitter now has two signatories (operator + owner), so both must authorize.
  submit (actAs operator <> actAs bob) do archiveCmd emId   -- Archive Emitter
  [(regId, _)] <- query @EmitterRegistry operator
  submit operator do archiveCmd regId           -- Archive EmitterRegistry
  pure ()