-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

-- | Daml script tests showing that the token standard can be used to execute
-- free-of-payment transfers of Amulet tokens; and how to do so.
module Splice.Tests.TestAmuletTokenTransfer where

import Splice.Api.Token.MetadataV1
import Splice.Api.Token.HoldingV1
import Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1

import Daml.Script

import DA.Action (when, unless)
import DA.Assert ((===))
import DA.Foldable (forA_)
import DA.List (sortOn)
import qualified DA.Map as Map
import qualified DA.TextMap as TextMap
import DA.Optional (isSome)
import DA.Time

import Splice.Amulet (AppRewardCoupon(..))
import Splice.Amulet.TokenApiUtils (createdInRoundMetaKey, ratePerRoundMetaKey, burnedMetaKey)

import Splice.Testing.Utils
import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry
import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi
import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient


-- Shared test setup
--------------------

data FeesConfig = WithFees | NoFees
  deriving (Eq, Show)

data TestSetup = TestSetup with
  registry : AmuletRegistry.AmuletRegistry
  alice : Party
  aliceValidator : Party
  bob : Party
  now : Time
  defaultTransfer : Api.Token.TransferInstructionV1.Transfer
  feesConfig : FeesConfig

setupTest : FeesConfig -> Script TestSetup
setupTest feesConfig = do
  registry <- AmuletRegistry.initialize AmuletRegistry.defaultAmuletRegistryConfig with
      noTransferFee = feesConfig == NoFees
  alice <- allocatePartyExact "alice"
  aliceValidator <- allocatePartyExact "alice-validator"
  bob <- allocatePartyExact "bob"

  -- Alice creates a transfer pre-approval. This contract can be used to execute an instant transfer
  -- from Bob to Alice (it needs to be disclosed as part of transfer initiation).
  now <- getTime
  let expiresAt = (now `addRelTime` days 30)
  AmuletRegistry.createTransferPreapproval registry alice aliceValidator expiresAt

  -- feature the alice's validator party, to check that they get featured registry rewards
  AmuletRegistry.featureApp registry aliceValidator

  -- also feature alice and bob so that we can easily check that their self-transfers
  -- do not result in featured app rewards
  AmuletRegistry.featureApp registry alice
  AmuletRegistry.featureApp registry bob

  -- Bob taps coin to send to Alice.
  AmuletRegistry.tapLockedAndUnlockedFunds registry bob 50.0

  bobHoldings <- WalletClient.listHoldings bob registry.instrumentId
  let bobHoldingCids = map fst bobHoldings
  let actualBobHoldingViews = sortOn (.lock) $ map snd bobHoldings
  let expectedBobHoldingViews = sortOn (.lock) $
        [ HoldingView with
            owner = bob
            instrumentId = InstrumentId with id = "Amulet", admin = registry.dso
            amount = 25.0
            lock = None
            meta = Metadata with

              values = TextMap.fromList
                [ (createdInRoundMetaKey, "1")
                , (ratePerRoundMetaKey, "0.00004")
                ]
        , HoldingView with
            owner = bob
            instrumentId = InstrumentId with id = "Amulet", admin = registry.dso
            amount = 25.0
            lock = Some $ Lock with
              expiresAt = Some now
              expiresAfter = None
              holders = [registry.dso]
              context = Some "test expired lock"
            meta = Metadata with
              values = TextMap.fromList
                [ (createdInRoundMetaKey, "1")
                , (ratePerRoundMetaKey, "0.00004")
                ]
        ]
  expectedBobHoldingViews === actualBobHoldingViews


  -- Check initial balance setup
  WalletClient.checkBalance alice registry.instrumentId 0.0
  WalletClient.checkBalance bob registry.instrumentId 50.0

  -- Define default transfer from Bob to Alice
  let
    defaultTransfer = Api.Token.TransferInstructionV1.Transfer with
      sender = bob
      receiver = alice
      amount = 10.0
      instrumentId = registry.instrumentId
      requestedAt = now
      executeBefore = now `addRelTime` days 1
      inputHoldingCids = bobHoldingCids
      meta = Metadata with
        values = TextMap.fromList [("token-metadata-v1.splice.lfdecentralizedtrust.org/correlation-id", "<test-UUID>")]

  return TestSetup with ..


setupTwoStepTransfer : FeesConfig -> Script (TestSetup, ContractId TransferInstruction)
setupTwoStepTransfer feesConfig = do
  testSetup@TestSetup {..} <- setupTest feesConfig

  -- fund alice
  AmuletRegistry.tapLockedAndUnlockedFunds registry alice 1000.0
  aliceHoldingCids <- WalletClient.listHoldings alice registry.instrumentId

  WalletClient.checkBalance alice registry.instrumentId 1000.0
  checkBalanceWith feesConfig bob registry.instrumentId 50.0

  -- check that the default transfer can be executed
  let transfer = defaultTransfer with
        sender = alice
        receiver = bob  -- turn this around so that the transfer is a two-step one
        inputHoldingCids = map fst aliceHoldingCids

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer
    extraArgs = emptyExtraArgs

  TextMap.size enrichedChoice.arg.extraArgs.context.values === 2
  Map.size enrichedChoice.disclosures.disclosures === 3

  -- Trigger a two-step transfer
  -- TODO(tech-debt): test here and for all steps that the expected ledger time bounds are present on the submissions
  result <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg
  TransferInstructionResult_Pending aliceInstrCid <- pure result.output

  -- check that the change is returned as expected
  [senderChangeCid] <- pure result.senderChangeCids
  Some senderChange <- queryInterfaceContractId @Holding alice senderChangeCid
  senderChange.lock === None
  checkHoldingWith feesConfig alice senderChangeCid (1000.0 - transfer.amount)
  expectBurn feesConfig result.meta
  pure (testSetup, aliceInstrCid)

assertNoFeaturedRewards : [Party] -> Script ()
assertNoFeaturedRewards parties =
  forA_ parties $ \party -> do
    rewards <- query @AppRewardCoupon party
    filter (._2.featured) rewards === []

expectBurn : FeesConfig -> Metadata -> Script ()
expectBurn NoFees meta =
  when (isSome $ TextMap.lookup burnedMetaKey meta.values) $
    fail $ "Did not expect burned meta key to be present in " <> show meta
expectBurn WithFees meta =
  unless (isSome $ TextMap.lookup burnedMetaKey meta.values) $
    fail $ "Expected burned meta key to be present in " <> show meta

checkBalanceWith : FeesConfig -> Party -> InstrumentId -> Decimal -> Script ()
checkBalanceWith NoFees = WalletClient.checkBalance
checkBalanceWith WithFees = WalletClient.checkBalanceApprox

checkHoldingWith : FeesConfig -> Party -> ContractId Holding -> Decimal -> Script ()
checkHoldingWith NoFees = WalletClient.checkHolding
checkHoldingWith WithFees = WalletClient.checkHoldingApprox


-- Testing self and direct transfers
------------------------------------

test_happy_path_self_with_fees : Script ()
test_happy_path_self_with_fees = test_happy_path_self WithFees

test_happy_path_self_no_fees : Script ()
test_happy_path_self_no_fees = test_happy_path_self NoFees

test_happy_path_self : FeesConfig -> Script ()
test_happy_path_self feesConfig = script do
  TestSetup {..} <- setupTest feesConfig

  -- check that the default transfer can be executed
  let transfer = defaultTransfer with
        sender = bob
        receiver = bob

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer
    extraArgs = emptyExtraArgs

  TextMap.size enrichedChoice.arg.extraArgs.context.values === 2
  Map.size enrichedChoice.disclosures.disclosures === 3

  checkBalanceWith feesConfig bob registry.instrumentId 50.0

  -- Trigger a self-transfer
  result <- submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg

  -- check holdings and rewards
  TransferInstructionResult_Completed [splitHoldingCid] <- pure result.output
  WalletClient.checkHolding bob splitHoldingCid 10.0
  [changeHoldingCid] <- pure result.senderChangeCids
  checkHoldingWith feesConfig bob changeHoldingCid 40.0
  expectBurn feesConfig result.meta

  assertNoFeaturedRewards [alice, bob]
  pure ()


test_happy_path_direct_with_fees : Script ()
test_happy_path_direct_with_fees = test_happy_path_direct WithFees

test_happy_path_direct_no_fees : Script ()
test_happy_path_direct_no_fees = test_happy_path_direct NoFees

test_happy_path_direct : FeesConfig -> Script ()
test_happy_path_direct feesConfig = script do
  TestSetup {..} <- setupTest feesConfig

  -- check that the default transfer can be executed
  let transfer = defaultTransfer

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer
    extraArgs = emptyExtraArgs

  TextMap.size enrichedChoice.arg.extraArgs.context.values === 4
  Map.size enrichedChoice.disclosures.disclosures === 5

  checkBalanceWith feesConfig bob registry.instrumentId 50.0

  -- Trigger an atomic, single-transaction transfer
  result <- submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg
  TransferInstructionResult_Completed receiverHoldingCids <- pure result.output
  case result.senderChangeCids of
    [holdingCid] -> checkHoldingWith feesConfig bob holdingCid 40.0
    cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids)
  case receiverHoldingCids of
    [holdingCid] -> checkHoldingWith feesConfig alice holdingCid 10.0
    cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids)
  expectBurn feesConfig result.meta

  -- check balance
  WalletClient.checkBalance alice registry.instrumentId 10.0
  checkBalanceWith feesConfig bob registry.instrumentId 40.0

  -- there is a featured registry reward for aliceValidator that created Alice's transfer preapproval
  [(_, aliceValidatorCoupon)] <- query @AppRewardCoupon aliceValidator
  aliceValidatorCoupon.featured === True
  aliceValidatorCoupon.amount ===
    case feesConfig of
      NoFees -> 2.0
      WithFees -> 2.16

  assertNoFeaturedRewards [alice, bob]
  pure ()


-- Testing two-step transfers
-----------------------------

test_two_step_success_with_fees : Script ()
test_two_step_success_with_fees = test_two_step_success WithFees

test_two_step_success_no_fees : Script ()
test_two_step_success_no_fees = test_two_step_success NoFees

test_two_step_success : FeesConfig -> Script ()
test_two_step_success feesConfig = do
  (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer feesConfig

  -- check locked holding
  [(_, lockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId
  let expectedLock = Some $ Lock with
        expiresAt = Some (defaultTransfer.executeBefore)
        expiresAfter = None
        holders = [registry.dso]
        context = Some "transfer to 'bob'"
  lockedHolding.lock === expectedLock
  case feesConfig of
    NoFees -> lockedHolding.amount === 10.0 -- yay, no fee reserve required!
    WithFees ->
      unless (lockedHolding.amount > 10.0) $
        abort "Expected locked holding amount to be greater than 10.0 due to fees reserve"


  -- bob queries the pending transfer through their wallet
  aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId
  [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId
  bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ]
  bobInstrCid === aliceInstrCid

  -- bob accepts the transfer
  context <- RegistryApi.getTransferInstruction_AcceptContext registry bobInstrCid emptyMetadata
  result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Accept with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata

  TransferInstructionResult_Completed receiverHoldingCids <- pure result.output
  case feesConfig of
    NoFees -> result.senderChangeCids === [] -- no fee reserve required! yay!
    WithFees ->
      case result.senderChangeCids of
        [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 1.0
        cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids)

  case receiverHoldingCids of
    [holdingCid] ->
      checkHoldingWith feesConfig bob holdingCid 10.0
    cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids)
  expectBurn feesConfig result.meta

  -- check balance
  checkBalanceWith feesConfig alice registry.instrumentId 990.0
  WalletClient.checkBalance bob registry.instrumentId 60.0

  assertNoFeaturedRewards [alice, bob]


test_two_step_withdraw_with_fees : Script ()
test_two_step_withdraw_with_fees = test_two_step_withdraw WithFees

test_two_step_withdraw_no_fees : Script ()
test_two_step_withdraw_no_fees = test_two_step_withdraw NoFees

test_two_step_withdraw : FeesConfig -> Script ()
test_two_step_withdraw feesConfig = do
  (TestSetup {..}, aliceInstrCid0) <- setupTwoStepTransfer feesConfig

  -- alice queries the pending transfer through their wallet
  [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId
  [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId
  aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ]
  aliceInstrCid0 === aliceInstrCid

  -- alice rejects the transfer
  context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata
  result <- submitWithDisclosures' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata


  case result.senderChangeCids of
    [holdingCid] ->
      checkHoldingWith feesConfig alice holdingCid 10.0
    cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids)
  TransferInstructionResult_Failed === result.output

  -- check balance
  checkBalanceWith feesConfig alice registry.instrumentId 1000.0
  WalletClient.checkBalance bob registry.instrumentId 50.0

  assertNoFeaturedRewards [alice, bob]


test_two_step_withdraw_locked_amulet_gone_with_fees : Script ()
test_two_step_withdraw_locked_amulet_gone_with_fees = test_two_step_withdraw_locked_amulet_gone WithFees

test_two_step_withdraw_locked_amulet_gone_no_fees : Script ()
test_two_step_withdraw_locked_amulet_gone_no_fees = test_two_step_withdraw_locked_amulet_gone NoFees

test_two_step_withdraw_locked_amulet_gone : FeesConfig -> Script ()
test_two_step_withdraw_locked_amulet_gone feesConfig = do
  (TestSetup {..}, aliceInstrCid0) <- setupTwoStepTransfer feesConfig

  -- alice queries the pending transfer through their wallet
  [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId
  [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId
  aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ]
  aliceInstrCid0 === aliceInstrCid

  -- pass time and unlock the amulet as the alice
  let [lockedCid] = aliceInstrView.transfer.inputHoldingCids
  setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1)
  AmuletRegistry.expireLockAsOwner registry lockedCid

  -- locked holdings are gone
  lockedHoldings <- WalletClient.listLockedHoldings alice registry.instrumentId
  lockedHoldings === []

  -- withdraw fails if the time is too early
  context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata
  setTime (aliceInstrView.transfer.executeBefore `addRelTime` negate (days 1))
  submitWithDisclosuresMustFail' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata

  -- move time back to the future (TM) so withdrawal can complete
  setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1)

  -- alice withdraws the transfer
  context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata
  result <- submitWithDisclosures' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata

  result.senderChangeCids === []
  result.output === TransferInstructionResult_Failed

  -- check balance
  checkBalanceWith feesConfig alice registry.instrumentId 1000.0
  WalletClient.checkBalance bob registry.instrumentId 50.0

  assertNoFeaturedRewards [alice, bob]


test_two_step_reject_with_fees : Script ()
test_two_step_reject_with_fees = test_two_step_reject WithFees

test_two_step_reject_no_fees : Script ()
test_two_step_reject_no_fees = test_two_step_reject NoFees

test_two_step_reject : FeesConfig -> Script ()
test_two_step_reject feesConfig = do
  (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer feesConfig

  -- bob queries the pending transfer through their wallet
  aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId
  [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId
  bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ]
  bobInstrCid === aliceInstrCid

  -- bob rejects the transfer
  context <- RegistryApi.getTransferInstruction_RejectContext registry bobInstrCid emptyMetadata
  result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Reject with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata

  case result.senderChangeCids of
    [holdingCid] ->
      checkHoldingWith feesConfig alice holdingCid 10.0
    cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids)
  result.output === TransferInstructionResult_Failed

  -- check balance
  checkBalanceWith feesConfig alice registry.instrumentId 1000.0
  WalletClient.checkBalance bob registry.instrumentId 50.0

  assertNoFeaturedRewards [alice, bob]


test_two_step_reject_locked_amulet_gone_with_fees : Script ()
test_two_step_reject_locked_amulet_gone_with_fees = test_two_step_reject_locked_amulet_gone WithFees

test_two_step_reject_locked_amulet_gone_no_fees : Script ()
test_two_step_reject_locked_amulet_gone_no_fees = test_two_step_reject_locked_amulet_gone NoFees

test_two_step_reject_locked_amulet_gone : FeesConfig -> Script ()
test_two_step_reject_locked_amulet_gone feesConfig = do
  (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer feesConfig

  -- bob queries the pending transfer through their wallet
  aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId
  [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId
  bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ]
  bobInstrCid === aliceInstrCid

  -- pass time and unlock the amulet as the owner
  let [lockedCid] = bobInstrView.transfer.inputHoldingCids
  setTime (bobInstrView.transfer.executeBefore `addRelTime` days 1)
  AmuletRegistry.expireLockAsOwner registry lockedCid

  -- bob rejects the transfer
  context <- RegistryApi.getTransferInstruction_RejectContext registry bobInstrCid emptyMetadata
  result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Reject with
    extraArgs = ExtraArgs with
      context = context.choiceContext
      meta = emptyMetadata

  result.senderChangeCids === []
  result.output === TransferInstructionResult_Failed

  -- check balance
  checkBalanceWith feesConfig alice registry.instrumentId 1000.0
  WalletClient.checkBalance bob registry.instrumentId 50.0

  assertNoFeaturedRewards [alice, bob]


-- Testing the shared validation logic for initiating transfers
---------------------------------------------------------------

test_no_holdings : Script ()
test_no_holdings = script do
  TestSetup {..} <- setupTest NoFees

  -- check that the default transfer can be executed
  let transfer = defaultTransfer with
        inputHoldingCids = []

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer
    extraArgs = emptyExtraArgs

  -- Show that the actual transfer choice fails
  submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg

  assertNoFeaturedRewards [alice, bob]
  pure ()

test_expired : Script ()
test_expired = script do
  TestSetup {..} <- setupTest NoFees

  let transfer = defaultTransfer
  setTime (transfer.executeBefore `addRelTime` days 1)

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer
    extraArgs = emptyExtraArgs

  -- Show that the actual transfer choice fails
  submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg

  assertNoFeaturedRewards [alice, bob]
  pure ()


test_wrong_admin : Script ()
test_wrong_admin = script do
  TestSetup {..} <- setupTest NoFees

  let transfer = defaultTransfer
  setTime (transfer.executeBefore `addRelTime` days 1)

  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = alice -- set the wrong admin
    transfer
    extraArgs = emptyExtraArgs

  -- Show that the actual transfer choice fails
  submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg

  assertNoFeaturedRewards [alice, bob]
  pure ()

test_factory_PublicFetch : Script ()
test_factory_PublicFetch = do
  TestSetup {..} <- setupTest NoFees
  -- we check that the public fetch choice works using a transfer factory's choice context
  enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with
    expectedAdmin = registry.dso
    transfer = defaultTransfer
    extraArgs = emptyExtraArgs
  view <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid TransferFactory_PublicFetch
    with
      expectedAdmin = registry.dso
      actor = alice
  view === Api.Token.TransferInstructionV1.TransferFactoryView registry.dso emptyMetadata