Tests.daml

module Tests where

import Daml.Script
import LedgerFactor

data Parties = Parties
  with
    supplier : Party
    buyer : Party
    financier : Party
    auditor : Party

setupParties : Script Parties
setupParties = do
  supplier <- allocateParty "Supplier"
  buyer <- allocateParty "Buyer"
  financier <- allocateParty "Financier"
  auditor <- allocateParty "Auditor"
  pure Parties with supplier, buyer, financier, auditor

confirmedInvoice : Parties -> Decimal -> Text -> Script (ContractId Invoice)
confirmedInvoice p amount description = do
  iid <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = []
      amount
      invoiceNumber = description
      description
      status = Issued
  submit p.buyer do exerciseCmd iid Confirm

listedInvoice : Parties -> Decimal -> Text -> Script (ContractId Invoice)
listedInvoice p amount description = do
  cid <- confirmedInvoice p amount description
  submit p.supplier do exerciseCmd cid ListForFinancing with newFinanciers = [p.financier]

makeOffer : Parties -> ContractId Invoice -> Decimal -> Decimal -> Script (ContractId FinancingOffer)
makeOffer p invoiceCid faceAmount discountRate = do
  prop <- submit p.financier do
    createCmd FinancingProposal with
      financier = p.financier
      supplier = p.supplier
      buyer = p.buyer
      auditor = p.auditor
      invoiceCid
      faceAmount
      discountRate
  submit p.supplier do exerciseCmd prop AcceptProposal

testSelectiveDisclosure : Script ()
testSelectiveDisclosure = do
  p <- setupParties
  invoiceCid <- confirmedInvoice p 100000.0 "Q3 pallets"
  _ <- makeOffer p invoiceCid 100000.0 0.03

  buyerOffers <- query @FinancingOffer p.buyer
  assertMsg "buyer must not see the financing offer that carries the margin" (null buyerOffers)

  buyerProposals <- query @FinancingProposal p.buyer
  assertMsg "buyer must not see the financing proposal either" (null buyerProposals)

  financierOffers <- query @FinancingOffer p.financier
  assertMsg "financier must see the offer with its margin" (length financierOffers == 1)

  supplierOffers <- query @FinancingOffer p.supplier
  assertMsg "supplier must see the offer with its margin" (length supplierOffers == 1)

  buyerInvoices <- query @Invoice p.buyer
  assertMsg "buyer must still see the invoice itself" (length buyerInvoices == 1)

testNoDoubleFinancing : Script ()
testNoDoubleFinancing = do
  p <- setupParties
  invoiceCid <- listedInvoice p 100000.0 "Q3 pallets"

  offer1 <- makeOffer p invoiceCid 100000.0 0.03
  offer2 <- makeOffer p invoiceCid 100000.0 0.05

  cash1 <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  _ <- submit p.financier do exerciseCmd offer1 AcceptFinancing with financierCashCid = cash1

  cash2 <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  submitMustFail p.financier do exerciseCmd offer2 AcceptFinancing with financierCashCid = cash2

testHappyPathSettlement : Script ()
testHappyPathSettlement = do
  p <- setupParties
  invoiceCid <- listedInvoice p 100000.0 "Q3 pallets"
  offer <- makeOffer p invoiceCid 100000.0 0.03
  cash <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  _ <- submit p.financier do exerciseCmd offer AcceptFinancing with financierCashCid = cash

  supplierCash <- query @Cash p.supplier
  assertMsg "supplier must be paid the 97,000 advance" (any (\(_, c) -> c.amount == 97000.0) supplierCash)

  auditorView <- query @FinancedReceivable p.auditor
  assertMsg "auditor must see the financed receivable" (length auditorView == 1)
  assertMsg "auditor sees face value 100,000, never the margin" (any (\(_, r) -> r.faceAmount == 100000.0) auditorView)

  buyerReceivable <- query @FinancedReceivable p.buyer
  assertMsg "buyer sees it now owes the financier the face value" (length buyerReceivable == 1)

  oldInvoice <- query @Invoice p.supplier
  assertMsg "the original receivable is consumed after financing" (null oldInvoice)

bidOn : Parties -> Party -> ContractId Invoice -> Decimal -> Decimal -> Script (ContractId FinancingProposal)
bidOn p bidder invoiceCid faceAmount discountRate =
  submit bidder do
    createCmd FinancingProposal with
      financier = bidder
      supplier = p.supplier
      buyer = p.buyer
      auditor = p.auditor
      invoiceCid
      faceAmount
      discountRate

testSealedBidAuction : Script ()
testSealedBidAuction = do
  p <- setupParties
  apex <- allocateParty "Apex"
  cobalt <- allocateParty "Cobalt"

  iid <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = []
      amount = 100000.0
      invoiceNumber = "Q3 pallets"
      description = "Q3 pallets"
      status = Issued
  confirmed <- submit p.buyer do exerciseCmd iid Confirm
  listed <- submit p.supplier do exerciseCmd confirmed ListForFinancing with newFinanciers = [p.financier, apex, cobalt]

  b1 <- bidOn p p.financier listed 100000.0 0.019
  b2 <- bidOn p apex listed 100000.0 0.024
  _b3 <- bidOn p cobalt listed 100000.0 0.031

  meridianBids <- query @FinancingProposal p.financier
  assertMsg "each bidder sees only its own sealed bid (Meridian)" (length meridianBids == 1)
  apexBids <- query @FinancingProposal apex
  assertMsg "each bidder sees only its own sealed bid (Apex)" (length apexBids == 1)
  cobaltBids <- query @FinancingProposal cobalt
  assertMsg "each bidder sees only its own sealed bid (Cobalt)" (length cobaltBids == 1)

  supplierBids <- query @FinancingProposal p.supplier
  assertMsg "the supplier (auctioneer) sees all three sealed bids" (length supplierBids == 3)

  buyerBids <- query @FinancingProposal p.buyer
  assertMsg "the buyer sees no bids at all" (null buyerBids)

  offer <- submit p.supplier do exerciseCmd b1 AcceptProposal
  cash <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  _ <- submit p.financier do exerciseCmd offer AcceptFinancing with financierCashCid = cash

  winnerReceivable <- query @FinancedReceivable p.auditor
  assertMsg "the winning bid settles; auditor sees the financed receivable" (length winnerReceivable == 1)

  submitMustFail p.supplier do exerciseCmd b2 AcceptProposal

testFaceAmountMustMatchInvoice : Script ()
testFaceAmountMustMatchInvoice = do
  p <- setupParties
  invoiceCid <- listedInvoice p 100000.0 "Q3 pallets"

  inflatedOffer <- makeOffer p invoiceCid 500000.0 0.03
  bigCash <- submit p.financier do createCmd Cash with owner = p.financier, amount = 500000.0
  submitMustFail p.financier do exerciseCmd inflatedOffer AcceptFinancing with financierCashCid = bigCash

  honestOffer <- makeOffer p invoiceCid 100000.0 0.03
  goodCash <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  _ <- submit p.financier do exerciseCmd honestOffer AcceptFinancing with financierCashCid = goodCash

  receivables <- query @FinancedReceivable p.auditor
  assertMsg "the auditor only ever sees the true 100,000 face value" (all (\(_, r) -> r.faceAmount == 100000.0) receivables)

testNoDoublePledgeAcrossContracts : Script ()
testNoDoublePledgeAcrossContracts = do
  p <- setupParties

  inv1 <- listedInvoice p 100000.0 "INV-777"
  offer1 <- makeOffer p inv1 100000.0 0.03
  cash1 <- submit p.financier do createCmd Cash with owner = p.financier, amount = 100000.0
  _ <- submit p.financier do exerciseCmd offer1 AcceptFinancing with financierCashCid = cash1

  iid2 <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = []
      amount = 100000.0
      invoiceNumber = "INV-777"
      description = "INV-777"
      status = Issued
  submitMustFail p.buyer do exerciseCmd iid2 Confirm

  settled <- query @FinancedReceivable p.auditor
  assertMsg "the same invoice yields exactly one financed receivable, never two" (length settled == 1)

testForgedConfirmationCannotFinance : Script ()
testForgedConfirmationCannotFinance = do
  p <- setupParties
  iid <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = [p.financier]
      amount = 100000.0
      invoiceNumber = "FORGED-1"
      description = "FORGED-1"
      status = Confirmed
  prop <- submit p.financier do
    createCmd FinancingProposal with
      financier = p.financier
      supplier = p.supplier
      buyer = p.buyer
      auditor = p.auditor
      invoiceCid = iid
      faceAmount = 100000.0
      discountRate = 0.03
  submitMustFail p.supplier do exerciseCmd prop AcceptProposal

testForgedAmountCannotFinance : Script ()
testForgedAmountCannotFinance = do
  p <- setupParties

  small <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = []
      amount = 1000.0
      invoiceNumber = "INV-100"
      description = "genuine small invoice"
      status = Issued
  _ <- submit p.buyer do exerciseCmd small Confirm

  inflated <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = [p.financier]
      amount = 500000.0
      invoiceNumber = "INV-100"
      description = "inflated forgery"
      status = Confirmed
  prop <- submit p.financier do
    createCmd FinancingProposal with
      financier = p.financier
      supplier = p.supplier
      buyer = p.buyer
      auditor = p.auditor
      invoiceCid = inflated
      faceAmount = 500000.0
      discountRate = 0.03
  submitMustFail p.supplier do exerciseCmd prop AcceptProposal

testForgedBuyerCannotFinance : Script ()
testForgedBuyerCannotFinance = do
  p <- setupParties
  impostor <- allocateParty "Impostor"

  dummy <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = impostor
      financiers = []
      amount = 100000.0
      invoiceNumber = "INV-X"
      description = "self-attested dummy"
      status = Issued
  _ <- submit impostor do exerciseCmd dummy Confirm

  real <- submit p.supplier do
    createCmd Invoice with
      supplier = p.supplier
      buyer = p.buyer
      financiers = [p.financier]
      amount = 100000.0
      invoiceNumber = "INV-X"
      description = "names a buyer who never signed"
      status = Confirmed
  prop <- submit p.financier do
    createCmd FinancingProposal with
      financier = p.financier
      supplier = p.supplier
      buyer = p.buyer
      auditor = p.auditor
      invoiceCid = real
      faceAmount = 100000.0
      discountRate = 0.03
  submitMustFail p.supplier do exerciseCmd prop AcceptProposal