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

-- | Instruct transfers of holdings between parties.
module Splice.Api.Token.TransferInstructionV1 where

import qualified DA.Map as Map

import Splice.Api.Token.MetadataV1
import Splice.Api.Token.HoldingV1

-- | A specification of a transfer of holdings between two parties.
data Transfer = Transfer with
    sender : Party
      -- ^ The sender of the transfer.
    receiver : Party
      -- ^ The receiver of the transfer.
    amount : Decimal
      -- ^ The amount to transfer.
    instrumentId : InstrumentId
      -- ^ The instrument identifier.
    requestedAt : Time
      -- ^ Wallet provided timestamp when the transfer was requested.
      -- MUST be in the past when instructing the transfer.
    executeBefore : Time
      -- ^ Until when (exclusive) the transfer may be executed. MUST be in the
      -- future when instructing the transfer.
      --
      -- Registries SHOULD NOT execute the transfer instruction after this time,
      -- so that senders can retry creating a new transfer instruction after this time.
    inputHoldingCids : [ContractId Holding]
      -- ^ The holding contracts that should be used to fund the transfer.
      --
      -- MAY be empty if the registry supports automatic selection of holdings for transfers
      -- or does not represent holdings on-ledger.
      --
      -- If specified, then the transfer MUST archive all of these holdings, so
      -- that the execution of the transfer conflicts with any other transfers
      -- using these holdings. Thereby allowing that the sender can use
      -- deliberate contention on holdings to prevent duplicate transfers.
    meta : Metadata
      -- ^ Metadata.
  deriving (Show, Eq)

-- | The result of instructing a transfer or advancing the state of a transfer instruction.
data TransferInstructionResult = TransferInstructionResult with
    output : TransferInstructionResult_Output
     -- ^ The output of the step.
    senderChangeCids : [ContractId Holding]
      -- ^ New holdings owned by the sender created to return "change". Can be used
      -- by callers to batch creating or updating multiple transfer instructions
      -- in a single Daml transaction.
    meta : Metadata
      -- ^ Additional metadata specific to the transfer instruction, used for extensibility; e.g., fees charged.
  deriving (Show, Eq)

-- | The output of instructing a transfer or advancing the state of a transfer instruction.
data TransferInstructionResult_Output
  = TransferInstructionResult_Pending
      -- ^ Use this result to communicate that the transfer is pending further steps.
      with
        transferInstructionCid : ContractId TransferInstruction
          -- ^ Contract id of the transfer instruction representing the pending state.
  | TransferInstructionResult_Completed
      -- ^ Use this result to communicate that the transfer succeeded and the receiver
      -- has received their holdings.
      with
        receiverHoldingCids : [ContractId Holding]
          -- ^ The newly created holdings owned by the receiver as part of successfully
          -- completing the transfer.
  | TransferInstructionResult_Failed
      -- ^ Use this result to communicate that the transfer did not succeed and all holdings (minus fees)
      -- have been returned to the sender.
  deriving (Show, Eq)


-- TransferInstruction
------------------------

-- | Status of a transfer instruction.
data TransferInstructionStatus
  = TransferPendingReceiverAcceptance
      -- ^ The transfer is pending acceptance by the receiver.
  | TransferPendingInternalWorkflow
      -- ^ The transfer is pending actions to be taken as part of registry internal workflows.
      with
        pendingActions : Map.Map Party Text
          -- ^ The actions that a party could take to advance the transfer.
          --
          -- This field can by used to inform wallet users whether they need to take an action or not.
  deriving (Show, Eq)

-- | View for `TransferInstruction`.
data TransferInstructionView = TransferInstructionView with
    originalInstructionCid : Optional (ContractId TransferInstruction)
      -- ^ The contract id of the original transfer instruction contract.
      -- Used by the wallet to track the lineage of transfer instructions through multiple steps.
      --
      -- Only set if the registry evolves the transfer instruction in multiple steps.
    transfer : Transfer
      -- ^ The transfer specified by the transfer instruction.
    status : TransferInstructionStatus
      -- ^ The status of the transfer instruction.
    meta : Metadata
      -- ^ Additional metadata specific to the transfer instruction, used for extensibility; e.g., more detailed status information.
  deriving (Show, Eq)

-- | An interface for tracking the status of a transfer instruction,
-- i.e., a request to a registry app to execute a transfer.
--
-- Registries MAY evolve the transfer instruction in multiple steps. They SHOULD
-- do so using only the choices on this interface, so that wallets can reliably
-- parse the transaction history and determine whether the instruction ultimately
-- succeeded or failed.
interface TransferInstruction where
  viewtype TransferInstructionView

  transferInstruction_acceptImpl : ContractId TransferInstruction -> TransferInstruction_Accept -> Update TransferInstructionResult
  transferInstruction_rejectImpl : ContractId TransferInstruction -> TransferInstruction_Reject -> Update TransferInstructionResult
  transferInstruction_withdrawImpl : ContractId TransferInstruction -> TransferInstruction_Withdraw -> Update TransferInstructionResult
  transferInstruction_updateImpl : ContractId TransferInstruction -> TransferInstruction_Update -> Update TransferInstructionResult

  choice TransferInstruction_Accept : TransferInstructionResult
    -- ^ Accept the transfer as the receiver.
    --
    -- This choice is only available if the instruction is in
    -- `TransferPendingReceiverAcceptance` state.
    --
    -- Note that while implementations will typically return `TransferInstructionResult_Completed`,
    -- this is not guaranteed. The result of the choice is implementation-specific and MAY
    -- be any of the three possible results.
    with
      extraArgs : ExtraArgs
        -- ^ Additional context required in order to exercise the choice.
    controller (view this).transfer.receiver
    do transferInstruction_acceptImpl this self arg

  choice TransferInstruction_Reject : TransferInstructionResult
    -- ^ Reject the transfer as the receiver.
    --
    -- This choice is only available if the instruction is in
    -- `TransferPendingReceiverAcceptance` state.
    with
      extraArgs : ExtraArgs
        -- ^ Additional context required in order to exercise the choice.
    controller (view this).transfer.receiver
    do transferInstruction_rejectImpl this self arg

  choice TransferInstruction_Withdraw : TransferInstructionResult
    -- ^ Withdraw the transfer instruction as the sender.
    with
      extraArgs : ExtraArgs
        -- ^ Additional context required in order to exercise the choice.
    controller (view this).transfer.sender
    do transferInstruction_withdrawImpl this self arg

  choice TransferInstruction_Update : TransferInstructionResult
    -- ^ Update the state of the transfer instruction. Used by the registry to
    -- execute registry internal workflow steps that advance the state of the
    -- transfer instruction. A reason may be communicated via the metadata.
    with
      extraActors : [Party]
        -- ^ Extra actors authorizing the update. Implementations MUST check that
        -- this field contains the expected actors for the specific update.
      extraArgs : ExtraArgs
        -- ^ Additional context required in order to exercise the choice.
    controller (view this).transfer.instrumentId.admin, extraActors
    do transferInstruction_updateImpl this self arg


-- Transfer Factory
-------------------

-- | A factory contract to instruct transfers of holdings between parties.
interface TransferFactory where
  viewtype TransferFactoryView

  transferFactory_transferImpl : ContractId TransferFactory -> TransferFactory_Transfer -> Update TransferInstructionResult
  transferFactory_publicFetchImpl : ContractId TransferFactory -> TransferFactory_PublicFetch -> Update TransferFactoryView

  nonconsuming choice TransferFactory_Transfer : TransferInstructionResult
    -- ^ Instruct the registry to execute a transfer.
    -- Implementations MUST ensure that this choice fails if `transfer.executeBefore` is in the past.
    with
      expectedAdmin : Party
        -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches
        -- the admin of the factory.
        -- Callers SHOULD ensure they get `expectedAdmin` from a trusted source, e.g., a read against
        -- their own participant. That way they can ensure that it is safe to exercise a choice
        -- on a factory contract acquired from an untrusted source *provided*
        -- all vetted Daml packages only contain interface implementations
        -- that check the expected admin party.
      transfer : Transfer
        -- ^ The transfer to execute.
      extraArgs : ExtraArgs
        -- ^ The extra arguments to pass to the transfer implementation.
    controller transfer.sender
    do transferFactory_transferImpl this self arg

  nonconsuming choice TransferFactory_PublicFetch : TransferFactoryView
    -- ^ Fetch the view of the factory contract.
    with
      expectedAdmin : Party
        -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches
        -- the admin of the factory.
        -- Callers SHOULD ensure they get `expectedAdmin` from a trusted source, e.g., a read against
        -- their own participant. That way they can ensure that it is safe to exercise a choice
        -- on a factory contract acquired from an untrusted source *provided*
        -- all vetted Daml packages only contain interface implementations
        -- that check the expected admin party.
      actor : Party
        -- ^ The party fetching the contract.
    controller actor
    do transferFactory_publicFetchImpl this self arg

-- | View for `TransferFactory`.
data TransferFactoryView = TransferFactoryView
  with
    admin : Party
      -- ^ The party representing the registry app that administers the instruments for
      -- which this transfer factory can be used.
    meta : Metadata
      -- ^ Additional metadata specific to the transfer factory, used for extensibility.
  deriving (Show, Eq)