summaryrefslogtreecommitdiff
path: root/src/FundLab.Domain/Ledger.fs
diff options
context:
space:
mode:
Diffstat (limited to 'src/FundLab.Domain/Ledger.fs')
-rw-r--r--src/FundLab.Domain/Ledger.fs921
1 files changed, 921 insertions, 0 deletions
diff --git a/src/FundLab.Domain/Ledger.fs b/src/FundLab.Domain/Ledger.fs
new file mode 100644
index 0000000..2937ca6
--- /dev/null
+++ b/src/FundLab.Domain/Ledger.fs
@@ -0,0 +1,921 @@
+namespace FundLab.Domain
+
+open System
+
+type ResidualOwner =
+ | FundReserve
+ | ExternalParty
+
+type ResidualState =
+ | Clear
+ | RequiresAllocation of decimal
+ | Allocated of decimal * ResidualOwner
+
+type Holding =
+ {
+ InstrumentId: Guid
+ AvailableUnits: decimal
+ FrozenUnits: decimal
+ SettledValue: decimal
+ }
+
+type BalanceSheet =
+ {
+ AvailableCash: decimal
+ FrozenCash: decimal
+ SettledHoldingsValue: decimal
+ RedemptionReceivable: decimal
+ OtherInTransitAssets: decimal
+ Assets: decimal
+ RedemptionPayable: decimal
+ SubscriptionRefundPayable: decimal
+ FeePayable: decimal
+ OtherInTransitLiabilities: decimal
+ Liabilities: decimal
+ NetAssets: decimal
+ }
+
+type CashFlowKind =
+ | ExternalDeposit
+ | ExternalRedemption
+ | ExternalRedemptionPayment
+ | UnderlyingPurchase
+ | UnderlyingRedemption
+ | UnderlyingRedemptionReceipt
+
+type CashFlow =
+ {
+ TransactionId: Guid
+ FundId: Guid
+ Kind: CashFlowKind
+ EffectiveAt: DateTimeOffset
+ GrossCash: decimal
+ CreditedCash: decimal
+ ConvertedUnits: decimal
+ UnitNav: decimal option
+ RoundingResidual: decimal
+ ResidualOwner: ResidualOwner option
+ IsSynthetic: bool
+ }
+
+type ExternalRedemptionStatus =
+ | PendingPayment
+ | Paid
+
+type ExternalRedemptionRecord =
+ {
+ TransactionId: Guid
+ FundId: Guid
+ IdempotencyKey: string
+ Units: decimal
+ UnitNav: decimal
+ PayableCash: decimal
+ Status: ExternalRedemptionStatus
+ ConfirmedAt: DateTimeOffset
+ PaidAt: DateTimeOffset option
+ IsSynthetic: bool
+ }
+
+type ResidualAllocationRecord =
+ {
+ TransactionId: Guid
+ FundId: Guid
+ Amount: decimal
+ Owner: ResidualOwner
+ EffectiveAt: DateTimeOffset
+ IsSynthetic: bool
+ }
+
+type LedgerEvent =
+ {
+ TransactionId: Guid
+ FundId: Guid
+ EventType: string
+ EffectiveAt: DateTimeOffset
+ CashAmount: decimal
+ Units: decimal
+ RoundingResidual: decimal
+ ResidualOwner: ResidualOwner option
+ IsSynthetic: bool
+ }
+
+type LedgerOrderKind =
+ | Purchase
+ | Redemption
+
+type LedgerOrder =
+ {
+ Id: Guid
+ FundId: Guid
+ InstrumentId: Guid
+ Kind: LedgerOrderKind
+ IdempotencyKey: string
+ Status: OrderStatus
+ RequestedCash: decimal
+ RequestedUnits: decimal
+ ConfirmedCash: decimal
+ ConfirmedUnits: decimal
+ RoundingResidual: decimal
+ ResidualOwner: ResidualOwner option
+ IsSynthetic: bool
+ SubmittedAt: DateTimeOffset
+ ConfirmedAt: DateTimeOffset option
+ }
+
+type LedgerFund =
+ {
+ Id: Guid
+ Name: string
+ Currency: string
+ InitialCash: decimal
+ InitialUnitNav: decimal
+ IsSynthetic: bool
+ AvailableCash: decimal
+ FrozenCash: decimal
+ Holdings: Map<Guid, Holding>
+ OutstandingUnits: decimal
+ RedemptionPayable: decimal
+ RedemptionReceivable: decimal
+ OtherInTransitAssets: decimal
+ SubscriptionRefundPayable: decimal
+ FeePayable: decimal
+ OtherInTransitLiabilities: decimal
+ Status: FundStatus
+ Orders: Map<Guid, LedgerOrder>
+ ExternalRedemptions: Map<Guid, ExternalRedemptionRecord>
+ CashFlows: CashFlow list
+ Events: LedgerEvent list
+ ResidualAllocations: ResidualAllocationRecord list
+ ResidualState: ResidualState
+ }
+ with
+ member this.SettledHoldingsValue =
+ this.Holdings
+ |> Map.toSeq
+ |> Seq.sumBy (fun (_, holding) -> holding.SettledValue)
+
+ member this.balanceSheet =
+ let settledHoldingsValue = this.SettledHoldingsValue
+ let assets =
+ this.AvailableCash
+ + this.FrozenCash
+ + settledHoldingsValue
+ + this.RedemptionReceivable
+ + this.OtherInTransitAssets
+
+ let liabilities =
+ this.RedemptionPayable
+ + this.SubscriptionRefundPayable
+ + this.FeePayable
+ + this.OtherInTransitLiabilities
+
+ {
+ AvailableCash = this.AvailableCash
+ FrozenCash = this.FrozenCash
+ SettledHoldingsValue = settledHoldingsValue
+ RedemptionReceivable = this.RedemptionReceivable
+ OtherInTransitAssets = this.OtherInTransitAssets
+ Assets = assets
+ RedemptionPayable = this.RedemptionPayable
+ SubscriptionRefundPayable = this.SubscriptionRefundPayable
+ FeePayable = this.FeePayable
+ OtherInTransitLiabilities = this.OtherInTransitLiabilities
+ Liabilities = liabilities
+ NetAssets = assets - liabilities
+ }
+
+ member this.BalanceSheet = this.balanceSheet
+ member this.NetAssets = this.balanceSheet.NetAssets
+ member this.UnitNavStatus =
+ if this.OutstandingUnits = 0m then
+ UnitNavStatus.ZeroUnits
+ else
+ UnitNavStatus.HasValue (this.NetAssets / this.OutstandingUnits)
+
+type LedgerState =
+ {
+ Funds: Map<Guid, LedgerFund>
+ Idempotencies: Map<Guid * string, string>
+ }
+
+type LedgerError =
+ | FundNotFound of Guid
+ | FundAlreadyExists of Guid
+ | OrderNotFound of Guid
+ | ExternalRedemptionNotFound of Guid
+ | IdempotencyConflict of string
+ | InvalidIdentifier of string
+ | InvalidAmount of string
+ | InvalidPrecision of string
+ | InvalidState of string
+ | TransactionAlreadyExists of Guid
+ | InsufficientCash of decimal
+ | InsufficientUnits of decimal
+ | ResidualOwnershipRequired of decimal
+
+module Ledger =
+ type private ResultBuilder() =
+ member _.Bind(result, binder) = Result.bind binder result
+ member _.Return(value) = Ok value
+ member _.ReturnFrom(result) = result
+ member _.Zero() = Ok()
+ member _.Combine(first, second) = Result.bind (fun () -> second) first
+ member _.Delay(generator) = generator()
+
+ let private result = ResultBuilder()
+
+ [<Literal>]
+ let CashScale = 2
+
+ [<Literal>]
+ let UnitScale = 8
+
+ let empty =
+ {
+ Funds = Map.empty
+ Idempotencies = Map.empty
+ }
+
+ let private decimalScale value =
+ let bits = Decimal.GetBits(value)
+ int ((bits[3] >>> 16) &&& 0x7f)
+
+ let private roundDown scale value =
+ Decimal.Round(value, scale, MidpointRounding.ToZero)
+
+ let private validateNonNegative label scale value =
+ if value < 0m then
+ Error(InvalidAmount label)
+ elif decimalScale value > scale then
+ Error(InvalidPrecision label)
+ else
+ Ok()
+
+ let private validatePositive label scale value =
+ validateNonNegative label scale value
+ |> Result.bind (fun () ->
+ if value = 0m then
+ Error(InvalidAmount label)
+ else
+ Ok())
+
+ let private fundStatus outstandingUnits =
+ if outstandingUnits = 0m then
+ FundStatus.ZeroUnits
+ else
+ FundStatus.Active
+
+ let getFund fundId state =
+ match state.Funds |> Map.tryFind fundId with
+ | Some fund -> Ok fund
+ | None -> Error(FundNotFound fundId)
+
+ let private updateFund fund state =
+ { state with Funds = state.Funds |> Map.add fund.Id fund }
+
+ let private validateIdentifier label value =
+ if value = Guid.Empty then
+ Error(InvalidIdentifier label)
+ else
+ Ok()
+
+ let private transactionExists transactionId fund =
+ fund.Events |> List.exists (fun event -> event.TransactionId = transactionId)
+ || fund.CashFlows |> List.exists (fun cashFlow -> cashFlow.TransactionId = transactionId)
+ || fund.ExternalRedemptions |> Map.containsKey transactionId
+ || fund.ResidualAllocations |> List.exists (fun allocation -> allocation.TransactionId = transactionId)
+
+ let private ensureTransactionIsNew transactionId fund =
+ if transactionExists transactionId fund then
+ Error(TransactionAlreadyExists transactionId)
+ else
+ Ok()
+
+ let private addResidual residual residualState =
+ if residual = 0m then
+ residualState
+ else
+ match residualState with
+ | Clear -> RequiresAllocation residual
+ | RequiresAllocation existing -> RequiresAllocation(existing + residual)
+ | Allocated _ -> RequiresAllocation residual
+
+ let private runIdempotent fundId key fingerprint state action =
+ if fundId = Guid.Empty then
+ Error(InvalidIdentifier "fund id")
+ elif String.IsNullOrWhiteSpace key then
+ Error(InvalidState "idempotency key cannot be empty")
+ else
+ match state.Idempotencies |> Map.tryFind (fundId, key) with
+ | Some previous when previous = fingerprint -> Ok state
+ | Some _ -> Error(IdempotencyConflict key)
+ | None ->
+ action state
+ |> Result.map (fun next ->
+ {
+ next with
+ Idempotencies = next.Idempotencies |> Map.add (fundId, key) fingerprint
+ })
+
+ let initializeFund fundId name initialCash initialUnitNav isSynthetic state =
+ result {
+ do! validateIdentifier "fund id" fundId
+ do! validateNonNegative "initial cash" CashScale initialCash
+ do! validatePositive "initial unit NAV" UnitScale initialUnitNav
+
+ if String.IsNullOrWhiteSpace name then
+ return! Error(InvalidState "fund name cannot be empty")
+
+ if state.Funds |> Map.containsKey fundId then
+ return! Error(FundAlreadyExists fundId)
+
+ let fund =
+ {
+ Id = fundId
+ Name = name
+ Currency = "CNY"
+ InitialCash = initialCash
+ InitialUnitNav = initialUnitNav
+ IsSynthetic = isSynthetic
+ AvailableCash = initialCash
+ FrozenCash = 0m
+ Holdings = Map.empty
+ OutstandingUnits = 0m
+ RedemptionPayable = 0m
+ RedemptionReceivable = 0m
+ OtherInTransitAssets = 0m
+ SubscriptionRefundPayable = 0m
+ FeePayable = 0m
+ OtherInTransitLiabilities = 0m
+ Status = FundStatus.Empty
+ Orders = Map.empty
+ ExternalRedemptions = Map.empty
+ CashFlows = []
+ Events = []
+ ResidualAllocations = []
+ ResidualState = Clear
+ }
+
+ return updateFund fund state
+ }
+
+ let private canIssueUnits fund =
+ match fund.ResidualState with
+ | RequiresAllocation residual when fund.OutstandingUnits = 0m ->
+ Error(ResidualOwnershipRequired residual)
+ | _ -> Ok()
+
+ let private addEvent transactionId eventType at cashAmount units residual owner isSynthetic fund =
+ {
+ fund with
+ Events =
+ {
+ TransactionId = transactionId
+ FundId = fund.Id
+ EventType = eventType
+ EffectiveAt = at
+ CashAmount = cashAmount
+ Units = units
+ RoundingResidual = residual
+ ResidualOwner = owner
+ IsSynthetic = isSynthetic
+ }
+ :: fund.Events
+ }
+
+ let confirmExternalDeposit fundId transactionId idempotencyKey grossCash unitNav effectiveAt isSynthetic state =
+ let fingerprint = sprintf "external-deposit|%O|%M|%M|%O|%b" transactionId grossCash unitNav effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "transaction id" transactionId
+ do! validatePositive "external deposit cash" CashScale grossCash
+ do! validatePositive "external deposit unit NAV" UnitScale unitNav
+
+ let! fund = getFund fundId current
+ do! ensureTransactionIsNew transactionId fund
+ do! canIssueUnits fund
+
+ let convertedUnits = roundDown UnitScale (grossCash / unitNav)
+ if convertedUnits = 0m then
+ return! Error(InvalidAmount "external deposit does not create units")
+
+ let creditedCash = roundDown CashScale (convertedUnits * unitNav)
+ let residual = grossCash - creditedCash
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash + creditedCash
+ OutstandingUnits = fund.OutstandingUnits + convertedUnits
+ Status = FundStatus.Active
+ ResidualState = addResidual residual fund.ResidualState
+ CashFlows =
+ {
+ TransactionId = transactionId
+ FundId = fundId
+ Kind = CashFlowKind.ExternalDeposit
+ EffectiveAt = effectiveAt
+ GrossCash = grossCash
+ CreditedCash = creditedCash
+ ConvertedUnits = convertedUnits
+ UnitNav = Some unitNav
+ RoundingResidual = residual
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ :: fund.CashFlows
+ }
+ |> addEvent transactionId "external_deposit_confirmed" effectiveAt creditedCash convertedUnits residual None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let private orderAlreadyExists orderId fund =
+ if fund.Orders |> Map.containsKey orderId then
+ Error(InvalidState "order already exists")
+ else
+ Ok()
+
+ let private emptyHolding instrumentId =
+ {
+ InstrumentId = instrumentId
+ AvailableUnits = 0m
+ FrozenUnits = 0m
+ SettledValue = 0m
+ }
+
+ let private addSettledHolding instrumentId units value holdings =
+ let holding = holdings |> Map.tryFind instrumentId |> Option.defaultValue (emptyHolding instrumentId)
+
+ holdings
+ |> Map.add instrumentId {
+ holding with
+ AvailableUnits = holding.AvailableUnits + units
+ SettledValue = holding.SettledValue + value
+ }
+
+ let private addCashFlow cashFlow fund =
+ { fund with CashFlows = cashFlow :: fund.CashFlows }
+
+ let private missingOrder orderId =
+ Error(OrderNotFound orderId)
+
+ let freezeUnderlyingPurchase fundId orderId idempotencyKey instrumentId requestedCash effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-purchase-freeze|%O|%O|%M|%O|%b" orderId instrumentId requestedCash effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ do! validateIdentifier "instrument id" instrumentId
+ do! validatePositive "underlying purchase cash" CashScale requestedCash
+ let! fund = getFund fundId current
+ do! orderAlreadyExists orderId fund
+ do! ensureTransactionIsNew orderId fund
+
+ if fund.AvailableCash < requestedCash then
+ return! Error(InsufficientCash requestedCash)
+
+ let order =
+ {
+ Id = orderId
+ FundId = fundId
+ InstrumentId = instrumentId
+ Kind = LedgerOrderKind.Purchase
+ IdempotencyKey = idempotencyKey
+ Status = OrderStatus.CashFrozen
+ RequestedCash = requestedCash
+ RequestedUnits = 0m
+ ConfirmedCash = 0m
+ ConfirmedUnits = 0m
+ RoundingResidual = 0m
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ SubmittedAt = effectiveAt
+ ConfirmedAt = None
+ }
+
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash - requestedCash
+ FrozenCash = fund.FrozenCash + requestedCash
+ Orders = fund.Orders |> Map.add orderId order
+ }
+ |> addEvent orderId "underlying_purchase_frozen" effectiveAt requestedCash 0m 0m None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let confirmUnderlyingPurchase fundId orderId idempotencyKey confirmedUnits unitNav effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-purchase-confirm|%O|%M|%M|%O|%b" orderId confirmedUnits unitNav effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ do! validatePositive "underlying purchase units" UnitScale confirmedUnits
+ do! validatePositive "underlying purchase unit NAV" UnitScale unitNav
+ let! fund = getFund fundId current
+ let! order = fund.Orders |> Map.tryFind orderId |> Option.map Ok |> Option.defaultValue (missingOrder orderId)
+
+ if order.Kind <> LedgerOrderKind.Purchase || order.Status <> OrderStatus.CashFrozen then
+ return! Error(InvalidState "underlying purchase is not cash frozen")
+
+ let grossCash = confirmedUnits * unitNav
+ let confirmedCash = roundDown CashScale grossCash
+ if confirmedCash <= 0m then
+ return! Error(InvalidAmount "underlying purchase cash rounds to zero")
+
+ if confirmedCash > order.RequestedCash then
+ return! Error(InvalidState "underlying purchase exceeds frozen cash")
+
+ let residual = grossCash - confirmedCash
+ let updatedOrder =
+ {
+ order with
+ Status = OrderStatus.Confirmed
+ ConfirmedCash = confirmedCash
+ ConfirmedUnits = confirmedUnits
+ RoundingResidual = residual
+ ResidualOwner = None
+ ConfirmedAt = Some effectiveAt
+ }
+
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash + order.RequestedCash - confirmedCash
+ FrozenCash = fund.FrozenCash - order.RequestedCash
+ Holdings = fund.Holdings |> addSettledHolding order.InstrumentId confirmedUnits confirmedCash
+ Orders = fund.Orders |> Map.add orderId updatedOrder
+ ResidualState = addResidual residual fund.ResidualState
+ }
+ |> addCashFlow {
+ TransactionId = orderId
+ FundId = fundId
+ Kind = CashFlowKind.UnderlyingPurchase
+ EffectiveAt = effectiveAt
+ GrossCash = grossCash
+ CreditedCash = confirmedCash
+ ConvertedUnits = confirmedUnits
+ UnitNav = Some unitNav
+ RoundingResidual = residual
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ |> addEvent orderId "underlying_purchase_confirmed" effectiveAt confirmedCash confirmedUnits residual None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let cancelUnderlyingPurchase fundId orderId idempotencyKey effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-purchase-cancel|%O|%O|%b" orderId effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ let! fund = getFund fundId current
+ let! order = fund.Orders |> Map.tryFind orderId |> Option.map Ok |> Option.defaultValue (missingOrder orderId)
+
+ if order.Kind <> LedgerOrderKind.Purchase || order.Status <> OrderStatus.CashFrozen then
+ return! Error(InvalidState "underlying purchase is not cancellable")
+
+ let updatedOrder = { order with Status = OrderStatus.Cancelled }
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash + order.RequestedCash
+ FrozenCash = fund.FrozenCash - order.RequestedCash
+ Orders = fund.Orders |> Map.add orderId updatedOrder
+ }
+ |> addEvent orderId "underlying_purchase_cancelled" effectiveAt order.RequestedCash 0m 0m None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let freezeUnderlyingRedemption fundId orderId idempotencyKey instrumentId requestedUnits effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-redemption-freeze|%O|%O|%M|%O|%b" orderId instrumentId requestedUnits effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ do! validateIdentifier "instrument id" instrumentId
+ do! validatePositive "underlying redemption units" UnitScale requestedUnits
+ let! fund = getFund fundId current
+ do! orderAlreadyExists orderId fund
+ do! ensureTransactionIsNew orderId fund
+ let! holding = fund.Holdings |> Map.tryFind instrumentId |> Option.map Ok |> Option.defaultValue (Error(InvalidState "holding not found"))
+
+ if holding.AvailableUnits < requestedUnits then
+ return! Error(InsufficientUnits requestedUnits)
+
+ let updatedHolding =
+ {
+ holding with
+ AvailableUnits = holding.AvailableUnits - requestedUnits
+ FrozenUnits = holding.FrozenUnits + requestedUnits
+ }
+
+ let order =
+ {
+ Id = orderId
+ FundId = fundId
+ InstrumentId = instrumentId
+ Kind = LedgerOrderKind.Redemption
+ IdempotencyKey = idempotencyKey
+ Status = OrderStatus.UnitsFrozen
+ RequestedCash = 0m
+ RequestedUnits = requestedUnits
+ ConfirmedCash = 0m
+ ConfirmedUnits = 0m
+ RoundingResidual = 0m
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ SubmittedAt = effectiveAt
+ ConfirmedAt = None
+ }
+
+ let updatedFund =
+ {
+ fund with
+ Holdings = fund.Holdings |> Map.add instrumentId updatedHolding
+ Orders = fund.Orders |> Map.add orderId order
+ }
+ |> addEvent orderId "underlying_redemption_frozen" effectiveAt 0m requestedUnits 0m None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let private releaseFrozenHolding holding units =
+ let totalUnits = holding.AvailableUnits + holding.FrozenUnits
+ let releasedValue =
+ if units = totalUnits then
+ holding.SettledValue
+ else
+ roundDown CashScale (holding.SettledValue * units / totalUnits)
+
+ let remaining =
+ {
+ holding with
+ FrozenUnits = holding.FrozenUnits - units
+ SettledValue = holding.SettledValue - releasedValue
+ }
+
+ remaining, releasedValue
+
+ let confirmUnderlyingRedemption fundId orderId idempotencyKey unitNav effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-redemption-confirm|%O|%M|%O|%b" orderId unitNav effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ do! validatePositive "underlying redemption unit NAV" UnitScale unitNav
+ let! fund = getFund fundId current
+ let! order = fund.Orders |> Map.tryFind orderId |> Option.map Ok |> Option.defaultValue (missingOrder orderId)
+
+ if order.Kind <> LedgerOrderKind.Redemption || order.Status <> OrderStatus.UnitsFrozen then
+ return! Error(InvalidState "underlying redemption is not units frozen")
+
+ let! holding = fund.Holdings |> Map.tryFind order.InstrumentId |> Option.map Ok |> Option.defaultValue (Error(InvalidState "holding not found"))
+ if holding.FrozenUnits < order.RequestedUnits then
+ return! Error(InsufficientUnits order.RequestedUnits)
+
+ let grossCash = order.RequestedUnits * unitNav
+ let receivable = roundDown CashScale grossCash
+ if receivable <= 0m then
+ return! Error(InvalidAmount "underlying redemption cash rounds to zero")
+
+ let residual = grossCash - receivable
+ let updatedHolding, _ = releaseFrozenHolding holding order.RequestedUnits
+ let updatedHoldings =
+ if updatedHolding.AvailableUnits = 0m && updatedHolding.FrozenUnits = 0m then
+ fund.Holdings |> Map.remove order.InstrumentId
+ else
+ fund.Holdings |> Map.add order.InstrumentId updatedHolding
+
+ let updatedOrder =
+ {
+ order with
+ Status = OrderStatus.Confirmed
+ ConfirmedCash = receivable
+ ConfirmedUnits = order.RequestedUnits
+ RoundingResidual = residual
+ ResidualOwner = None
+ ConfirmedAt = Some effectiveAt
+ }
+
+ let updatedFund =
+ {
+ fund with
+ Holdings = updatedHoldings
+ RedemptionReceivable = fund.RedemptionReceivable + receivable
+ Orders = fund.Orders |> Map.add orderId updatedOrder
+ ResidualState = addResidual residual fund.ResidualState
+ }
+ |> addCashFlow {
+ TransactionId = orderId
+ FundId = fundId
+ Kind = CashFlowKind.UnderlyingRedemption
+ EffectiveAt = effectiveAt
+ GrossCash = grossCash
+ CreditedCash = receivable
+ ConvertedUnits = order.RequestedUnits
+ UnitNav = Some unitNav
+ RoundingResidual = residual
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ |> addEvent orderId "underlying_redemption_confirmed" effectiveAt receivable order.RequestedUnits residual None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let receiveUnderlyingRedemption fundId orderId idempotencyKey effectiveAt isSynthetic state =
+ let fingerprint = sprintf "underlying-redemption-receive|%O|%O|%b" orderId effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "order id" orderId
+ let! fund = getFund fundId current
+ let! order = fund.Orders |> Map.tryFind orderId |> Option.map Ok |> Option.defaultValue (missingOrder orderId)
+
+ if order.Kind <> LedgerOrderKind.Redemption || order.Status <> OrderStatus.Confirmed then
+ return! Error(InvalidState "underlying redemption is not confirmed")
+
+ if fund.RedemptionReceivable < order.ConfirmedCash then
+ return! Error(InvalidState "underlying redemption receivable is unavailable")
+
+ let updatedOrder = { order with Status = OrderStatus.Settled }
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash + order.ConfirmedCash
+ RedemptionReceivable = fund.RedemptionReceivable - order.ConfirmedCash
+ Orders = fund.Orders |> Map.add orderId updatedOrder
+ }
+ |> addCashFlow {
+ TransactionId = orderId
+ FundId = fundId
+ Kind = CashFlowKind.UnderlyingRedemptionReceipt
+ EffectiveAt = effectiveAt
+ GrossCash = order.ConfirmedCash
+ CreditedCash = order.ConfirmedCash
+ ConvertedUnits = 0m
+ UnitNav = None
+ RoundingResidual = 0m
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ |> addEvent orderId "underlying_redemption_received" effectiveAt order.ConfirmedCash 0m 0m None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let allocateResidual fundId transactionId idempotencyKey owner effectiveAt isSynthetic state =
+ let fingerprint = sprintf "residual-allocation|%O|%A|%O|%b" transactionId owner effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "transaction id" transactionId
+ let! fund = getFund fundId current
+
+ match fund.ResidualState with
+ | RequiresAllocation residual ->
+ if fund.OutstandingUnits <> 0m then
+ return! Error(InvalidState "residual allocation requires zero outstanding units")
+
+ do! ensureTransactionIsNew transactionId fund
+ let allocation =
+ {
+ TransactionId = transactionId
+ FundId = fundId
+ Amount = residual
+ Owner = owner
+ EffectiveAt = effectiveAt
+ IsSynthetic = isSynthetic
+ }
+
+ let updatedFund =
+ {
+ fund with
+ ResidualState = Allocated(residual, owner)
+ ResidualAllocations = allocation :: fund.ResidualAllocations
+ }
+ |> addEvent transactionId "residual_allocated" effectiveAt 0m 0m residual (Some owner) isSynthetic
+
+ return updateFund updatedFund current
+ | _ ->
+ return! Error(InvalidState "no residual requires allocation")
+ })
+
+ let confirmExternalRedemption fundId transactionId idempotencyKey units unitNav effectiveAt isSynthetic state =
+ let fingerprint = sprintf "external-redemption|%O|%M|%M|%O|%b" transactionId units unitNav effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "transaction id" transactionId
+ do! validatePositive "external redemption units" UnitScale units
+ do! validatePositive "external redemption unit NAV" UnitScale unitNav
+
+ let! fund = getFund fundId current
+ do! ensureTransactionIsNew transactionId fund
+ if fund.OutstandingUnits < units then
+ return! Error(InsufficientUnits units)
+
+ let grossCash = units * unitNav
+ let payableCash = roundDown CashScale grossCash
+ if payableCash = 0m then
+ return! Error(InvalidAmount "external redemption cash rounds to zero")
+
+ let residual = grossCash - payableCash
+ let redemption =
+ {
+ TransactionId = transactionId
+ FundId = fundId
+ IdempotencyKey = idempotencyKey
+ Units = units
+ UnitNav = unitNav
+ PayableCash = payableCash
+ Status = ExternalRedemptionStatus.PendingPayment
+ ConfirmedAt = effectiveAt
+ PaidAt = None
+ IsSynthetic = isSynthetic
+ }
+
+ let updatedFund =
+ {
+ fund with
+ OutstandingUnits = fund.OutstandingUnits - units
+ RedemptionPayable = fund.RedemptionPayable + payableCash
+ Status = fundStatus (fund.OutstandingUnits - units)
+ ResidualState = addResidual residual fund.ResidualState
+ ExternalRedemptions = fund.ExternalRedemptions |> Map.add transactionId redemption
+ CashFlows =
+ {
+ TransactionId = transactionId
+ FundId = fundId
+ Kind = CashFlowKind.ExternalRedemption
+ EffectiveAt = effectiveAt
+ GrossCash = grossCash
+ CreditedCash = payableCash
+ ConvertedUnits = units
+ UnitNav = Some unitNav
+ RoundingResidual = residual
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ :: fund.CashFlows
+ }
+ |> addEvent transactionId "external_redemption_confirmed" effectiveAt payableCash units residual None isSynthetic
+
+ return updateFund updatedFund current
+ })
+
+ let payExternalRedemption fundId transactionId idempotencyKey effectiveAt isSynthetic state =
+ let fingerprint = sprintf "external-redemption-payment|%O|%O|%b" transactionId effectiveAt isSynthetic
+
+ runIdempotent fundId idempotencyKey fingerprint state (fun current ->
+ result {
+ do! validateIdentifier "transaction id" transactionId
+ let! fund = getFund fundId current
+ let! redemption =
+ fund.ExternalRedemptions
+ |> Map.tryFind transactionId
+ |> Option.map Ok
+ |> Option.defaultValue (Error(ExternalRedemptionNotFound transactionId))
+
+ if redemption.Status <> ExternalRedemptionStatus.PendingPayment then
+ return! Error(InvalidState "external redemption is already paid")
+
+ let payable = redemption.PayableCash
+
+ if fund.AvailableCash < payable then
+ return! Error(InsufficientCash payable)
+
+ let updatedRedemption = { redemption with Status = ExternalRedemptionStatus.Paid; PaidAt = Some effectiveAt }
+
+ let updatedFund =
+ {
+ fund with
+ AvailableCash = fund.AvailableCash - payable
+ RedemptionPayable = fund.RedemptionPayable - payable
+ ExternalRedemptions = fund.ExternalRedemptions |> Map.add transactionId updatedRedemption
+ CashFlows =
+ {
+ TransactionId = transactionId
+ FundId = fundId
+ Kind = CashFlowKind.ExternalRedemptionPayment
+ EffectiveAt = effectiveAt
+ GrossCash = payable
+ CreditedCash = payable
+ ConvertedUnits = 0m
+ UnitNav = None
+ RoundingResidual = 0m
+ ResidualOwner = None
+ IsSynthetic = isSynthetic
+ }
+ :: fund.CashFlows
+ }
+ |> addEvent transactionId "external_redemption_paid" effectiveAt payable 0m 0m None isSynthetic
+
+ return updateFund updatedFund current
+ })
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 19:55:15 +0000