module Aurets where

import qualified Splice.Api.Token.HoldingV1 as TH
import qualified Splice.Api.Token.TransferInstructionV1 as TT
import qualified Splice.Api.Token.MetadataV1 as TM

-- Local test asset only. No dollar backing, fiat redemption or bank connection.
-- Custom Daml contracts
-- Canton Token Standard interoperability is a separate adapter.

template MintPolicy
  with
    issuer : Party
    instrumentId : Text
    lifetimeCap : Decimal
    lifetimeIssued : Decimal
  where
    signatory issuer
    ensure lifetimeCap > 0.0 && lifetimeIssued >= 0.0 && lifetimeIssued <= lifetimeCap

    choice Mint : (ContractId MintPolicy, ContractId MintOffer)
      with
        recipient : Party
        quantity : Decimal
      controller issuer
      do
        assertMsg "Mint quantity must be positive" (quantity > 0.0)
        assertMsg "Lifetime issuance cap exceeded" (lifetimeIssued + quantity <= lifetimeCap)
        nextPolicy <- create this with lifetimeIssued = lifetimeIssued + quantity
        offer <- create MintOffer with
          issuer
          instrumentId
          recipient
          quantity
        pure (nextPolicy, offer)

template MintOffer
  with
    issuer : Party
    instrumentId : Text
    recipient : Party
    quantity : Decimal
  where
    signatory issuer
    observer recipient
    ensure quantity > 0.0

    choice AcceptMint : ContractId Holding
      controller recipient
      do
        create Holding with
          issuer
          instrumentId
          owner = recipient
          amount = quantity

    choice DeclineMint : ()
      controller recipient
      do pure ()

template Holding
  with
    issuer : Party
    instrumentId : Text
    owner : Party
    amount : Decimal
  where
    signatory issuer, owner
    ensure amount > 0.0

    interface instance TH.Holding for Holding where
      view = TH.HoldingView with
        owner
        instrumentId = TH.InstrumentId issuer instrumentId
        amount
        lock = None
        meta = TM.emptyMetadata

    choice OpenStandardTransfer : TT.TransferInstructionResult
      with
        transfer : TT.Transfer
      controller owner
      do
        now <- getTime
        assertMsg "Wrong instrument or sender" (transfer.instrumentId == TH.InstrumentId issuer instrumentId && transfer.sender == owner)
        assertMsg "Invalid time window" (transfer.requestedAt <= now && now < transfer.executeBefore)
        assertMsg "Invalid quantity" (transfer.amount > 0.0 && transfer.amount <= amount)
        assertMsg "Choose a different recipient" (transfer.receiver /= owner)
        let interfaceSelf = toInterfaceContractId @TH.Holding self
        assertMsg "Input holdings must match" (transfer.inputHoldingCids == [interfaceSelf])
        change <- if transfer.amount < amount then do
          cid <- create this with amount = amount - transfer.amount
          pure [toInterfaceContractId @TH.Holding cid]
        else pure []
        instruction <- create StandardTransfer with transfer
        pure TT.TransferInstructionResult with
          output = TT.TransferInstructionResult_Pending (toInterfaceContractId @TT.TransferInstruction instruction)
          senderChangeCids = change
          meta = TM.emptyMetadata

    choice OfferTransfer : ContractId TransferOffer
      with
        receiver : Party
        quantity : Decimal
      controller owner
      do
        assertMsg "Transfer amount must be positive" (quantity > 0.0)
        assertMsg "Insufficient tokens" (quantity <= amount)
        assertMsg "Choose a different recipient" (receiver /= owner)
        if quantity < amount then do
          _ <- create this with amount = amount - quantity
          pure ()
        else pure ()
        create TransferOffer with
          issuer
          instrumentId
          sender = owner
          receiver
          quantity

    choice Burn : ContractId BurnReceipt
      controller owner
      do
        burnedAt <- getTime
        create BurnReceipt with
          issuer
          instrumentId
          owner
          amount
          burnedAt

template TransferOffer
  with
    issuer : Party
    instrumentId : Text
    sender : Party
    receiver : Party
    quantity : Decimal
  where
    signatory issuer, sender
    observer receiver
    ensure quantity > 0.0 && sender /= receiver

    choice AcceptTransfer : ContractId Holding
      controller receiver
      do
        create Holding with
          issuer
          instrumentId
          owner = receiver
          amount = quantity

    choice RejectTransfer : ContractId Holding
      controller receiver
      do
        create Holding with
          issuer
          instrumentId
          owner = sender
          amount = quantity

    choice CancelTransfer : ContractId Holding
      controller sender
      do
        create Holding with
          issuer
          instrumentId
          owner = sender
          amount = quantity

template BurnReceipt
  with
    issuer : Party
    instrumentId : Text
    owner : Party
    amount : Decimal
    burnedAt : Time
  where
    signatory issuer, owner
    ensure amount > 0.0

-- Prototype registry factory. Visibility is explicitly granted to test participants.
-- Off-ledger registry discovery and allocation interfaces are not implemented here.
template StandardFactory
  with
    issuer : Party
    instrumentId : Text
    visibleTo : [Party]
  where
    signatory issuer
    observer visibleTo

    interface instance TT.TransferFactory for StandardFactory where
      view = TT.TransferFactoryView issuer TM.emptyMetadata
      transferFactory_publicFetchImpl _ arg = do
        assertMsg "Unexpected instrument admin" (arg.expectedAdmin == issuer)
        pure (TT.TransferFactoryView issuer TM.emptyMetadata)
      transferFactory_transferImpl _ arg = do
        assertMsg "Unexpected instrument admin" (arg.expectedAdmin == issuer)
        assertMsg "Wrong instrument" (arg.transfer.instrumentId == TH.InstrumentId issuer instrumentId)
        case arg.transfer.inputHoldingCids of
          [input] -> do
            let holdingCid = fromInterfaceContractId @Holding input
            exercise holdingCid OpenStandardTransfer with transfer = arg.transfer
          _ -> abort "This prototype requires exactly one input holding"

template StandardTransfer
  with
    transfer : TT.Transfer
  where
    signatory transfer.instrumentId.admin, transfer.sender
    observer transfer.receiver
    ensure transfer.amount > 0.0 && transfer.sender /= transfer.receiver

    interface instance TT.TransferInstruction for StandardTransfer where
      view = TT.TransferInstructionView with
        originalInstructionCid = None
        transfer
        status = TT.TransferPendingReceiverAcceptance
        meta = TM.emptyMetadata

      transferInstruction_acceptImpl _ _ = do
        now <- getTime
        assertMsg "Transfer has expired" (now < transfer.executeBefore)
        cid <- create Holding with
          issuer = transfer.instrumentId.admin
          instrumentId = transfer.instrumentId.id
          owner = transfer.receiver
          amount = transfer.amount
        pure TT.TransferInstructionResult with
          output = TT.TransferInstructionResult_Completed [toInterfaceContractId @TH.Holding cid]
          senderChangeCids = []
          meta = TM.emptyMetadata

      transferInstruction_rejectImpl _ _ = restoreStandardHolding transfer
      transferInstruction_withdrawImpl _ _ = restoreStandardHolding transfer
      transferInstruction_updateImpl _ _ = abort "No internal update workflow is supported"

restoreStandardHolding : TT.Transfer -> Update TT.TransferInstructionResult
restoreStandardHolding transfer = do
  cid <- create Holding with
    issuer = transfer.instrumentId.admin
    instrumentId = transfer.instrumentId.id
    owner = transfer.sender
    amount = transfer.amount
  pure TT.TransferInstructionResult with
    output = TT.TransferInstructionResult_Failed
    senderChangeCids = [toInterfaceContractId @TH.Holding cid]
    meta = TM.emptyMetadata