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 OutstandingUnits: decimal RedemptionPayable: decimal RedemptionReceivable: decimal OtherInTransitAssets: decimal SubscriptionRefundPayable: decimal FeePayable: decimal OtherInTransitLiabilities: decimal Status: FundStatus Orders: Map ExternalRedemptions: Map 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 Idempotencies: Map } 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() [] let CashScale = 2 [] 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 })