summaryrefslogtreecommitdiff
path: root/src/FundLab.Api/App.fs
diff options
context:
space:
mode:
authorSomhairle H. Marisol <[email protected]>2026-09-21 11:21:51 +0800
committerSomhairle H. Marisol <[email protected]>2026-09-21 11:21:51 +0800
commitb8811922f4e167d50efb8817da35a12d8a9d653b (patch)
treeb85cc56677be5d4d58ad2277f00cbc935933301e /src/FundLab.Api/App.fs
parent3d9398234a54774544eb48a1caed6a1b2d5132eb (diff)
downloadfund-lab-b8811922f4e167d50efb8817da35a12d8a9d653b.tar.gz
Add redemption order minimal closed loop (3d-3)
Redeem confirmed holdings end to end with exact decimal semantics: submission freezes position units (reserved_units) after an available-units check without touching cash, confirmation settles at the trade-date NAV with evidence and deferral rules identical to subscriptions, credits the fund with proceeds net of the stated fee, and writes off position cost pro rata (full redemption removes the position row). Cash conservation holds at every step: frozen shares and receivable cash never appear as available cash before settlement. Domain gains RedemptionPolicy (request validation plus proceeds/fee/ cost-release computation) with unit tests. Persistence adds redemption_orders, idempotency tables, reserved_units on positions and Create/Confirm repository members; the API exposes POST/GET /funds/{id}/redemptions and POST .../confirm. The frontend adds a 06/REDEEM panel (submit, confirm, pending reasons, confirmed proceeds/cost display), frozen-share display on the holdings panel, and refresh wiring. Browser QA gains a K-series covering freeze, settlement, cash accounting, replay and over-redemption rejection.
Diffstat (limited to 'src/FundLab.Api/App.fs')
-rw-r--r--src/FundLab.Api/App.fs143
1 files changed, 143 insertions, 0 deletions
diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs
index 97787aa..9712fc6 100644
--- a/src/FundLab.Api/App.fs
+++ b/src/FundLab.Api/App.fs
@@ -96,6 +96,7 @@ type FundPositionResponse =
{
instrumentCode: string
units: string
+ reservedUnits: string
costCash: string
lastConfirmedAt: string
valuationNav: string option
@@ -103,6 +104,25 @@ type FundPositionResponse =
valuationCollectedAt: string option
}
+type RedemptionOrderResponse =
+ {
+ id: Guid
+ fundId: Guid
+ instrumentCode: string
+ units: string
+ feeAmount: string
+ status: string
+ submittedAt: string
+ tradeDate: string
+ pendingReason: string option
+ confirmedAt: string option
+ confirmedNav: string option
+ confirmedNavDate: string option
+ confirmedProceeds: string option
+ confirmedCostReleased: string option
+ isSynthetic: bool
+ }
+
type FundPositionsResponse =
{
fundId: Guid
@@ -222,6 +242,25 @@ module App =
isSynthetic = order.IsSynthetic
}
+ let private redemptionResponse (order: RedemptionOrderRecord) : RedemptionOrderResponse =
+ {
+ id = order.Id
+ fundId = order.FundId
+ instrumentCode = order.InstrumentCode
+ units = decimalText order.Units
+ feeAmount = cashText order.FeeAmount
+ status = order.Status
+ submittedAt = timestampText order.SubmittedAt
+ tradeDate = dateText order.TradeDate
+ pendingReason = order.PendingReason
+ confirmedAt = order.ConfirmedAt |> Option.map timestampText
+ confirmedNav = order.ConfirmedNav |> Option.map decimalText
+ confirmedNavDate = order.ConfirmedNavDate |> Option.map dateText
+ confirmedProceeds = order.ConfirmedProceeds |> Option.map cashText
+ confirmedCostReleased = order.ConfirmedCostReleased |> Option.map cashText
+ isSynthetic = order.IsSynthetic
+ }
+
let private errorResponse status error message : HttpHandler =
setStatusCode status
>=> json ({
@@ -305,6 +344,31 @@ module App =
with
| :? JsonException -> Error "request body must be valid JSON"
+ let private parseRedemptionCommand (body: string) =
+ try
+ use document = JsonDocument.Parse(body)
+ let root = document.RootElement
+
+ if root.ValueKind <> JsonValueKind.Object then
+ Error "request body must be a JSON object"
+ else
+ match tryStringProperty root "instrumentCode", tryStringProperty root "units", tryStringProperty root "feeAmount" with
+ | Some code, Some unitsText, Some feeAmountText ->
+ match tryDecimal "units" unitsText, tryDecimal "feeAmount" feeAmountText with
+ | Ok units, Ok feeAmount ->
+ Ok
+ {
+ InstrumentCode = code
+ Units = units
+ FeeAmount = feeAmount
+ }
+ | Error message, _
+ | _, Error message -> Error message
+ | _ ->
+ Error "instrumentCode, units and feeAmount are required"
+ with
+ | :? JsonException -> Error "request body must be valid JSON"
+
let private invokeHandler handler next ctx = handler next ctx
let private unauthorized : HttpHandler =
@@ -462,6 +526,7 @@ module App =
{
instrumentCode = position.InstrumentCode
units = decimalText position.Units
+ reservedUnits = decimalText position.ReservedUnits
costCash = cashText position.CostCash
lastConfirmedAt = timestampText position.LastConfirmedAt
valuationNav = position.ValuationNav |> Option.map decimalText
@@ -481,6 +546,81 @@ module App =
with _ ->
errorResponse 500 "PERSISTENCE_ERROR" "position persistence failed" next ctx
+ let private createRedemption (repository: FundRepository) (fundIdText: string) : HttpHandler =
+ fun next ctx ->
+ task {
+ match Guid.TryParse fundIdText with
+ | false, _ ->
+ return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_REQUEST" "fund id must be a UUID") next ctx
+ | true, fundId ->
+ use reader = new StreamReader(ctx.Request.Body)
+ let! body = reader.ReadToEndAsync()
+ let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString()
+
+ match parseRedemptionCommand body with
+ | Error message ->
+ return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_REQUEST" message) next ctx
+ | Ok command ->
+ try
+ match repository.CreateRedemptionOrder(idempotencyKey, fundId, command) with
+ | RedemptionWriteResult.RedemptionCreated order ->
+ return! invokeHandler (setStatusCode 201 >=> json (redemptionResponse order)) next ctx
+ | RedemptionWriteResult.RedemptionReplayed order ->
+ return! invokeHandler (json (redemptionResponse order)) next ctx
+ | RedemptionWriteResult.RedemptionIdempotencyConflict ->
+ return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx
+ | RedemptionWriteResult.RedemptionInvalid message ->
+ return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_REQUEST" message) next ctx
+ | RedemptionWriteResult.RedemptionFundNotFound ->
+ return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx
+ | RedemptionWriteResult.RedemptionInstrumentNotFound ->
+ return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx
+ | RedemptionWriteResult.RedemptionInsufficientUnits ->
+ return! invokeHandler (errorResponse 409 "INSUFFICIENT_UNITS" "available holdings are not enough for the requested redemption units") next ctx
+ with _ ->
+ return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "redemption persistence failed") next ctx
+ }
+
+ let private getRedemptions (repository: FundRepository) (fundIdText: string) : HttpHandler =
+ fun next ctx ->
+ match Guid.TryParse fundIdText with
+ | false, _ -> errorResponse 400 "INVALID_FUND_ID" "fund id must be a UUID" next ctx
+ | true, fundId ->
+ try
+ match repository.GetFund fundId with
+ | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx
+ | Some _ ->
+ let orders = repository.GetRedemptionOrders fundId
+ json (orders |> List.map redemptionResponse) next ctx
+ with _ ->
+ errorResponse 500 "PERSISTENCE_ERROR" "redemption persistence failed" next ctx
+
+ let private confirmRedemption (repository: FundRepository) (fundIdText: string) (orderIdText: string) : HttpHandler =
+ fun next ctx ->
+ match Guid.TryParse fundIdText, Guid.TryParse orderIdText with
+ | (false, _), _
+ | _, (false, _) ->
+ errorResponse 400 "INVALID_CONFIRM_REQUEST" "fund id and order id must be UUIDs" next ctx
+ | (true, fundId), (true, orderId) ->
+ let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString()
+
+ try
+ match repository.ConfirmRedemptionOrder(idempotencyKey, fundId, orderId) with
+ | RedemptionConfirmed order
+ | RedemptionConfirmReplayed order
+ | RedemptionPendingNav order -> json (redemptionResponse order) next ctx
+ | RedemptionConfirmIdempotencyConflict ->
+ errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request" next ctx
+ | RedemptionAlreadyConfirmed ->
+ errorResponse 409 "ORDER_ALREADY_CONFIRMED" "order was already confirmed with a different idempotency key" next ctx
+ | RedemptionOrderNotFound -> errorResponse 404 "ORDER_NOT_FOUND" "order was not found" next ctx
+ | RedemptionInvalidStatus ->
+ errorResponse 409 "ORDER_INVALID_STATUS" "order is not in a confirmable status" next ctx
+ | RedemptionConfirmResult.RedemptionInvalid message ->
+ errorResponse 400 "INVALID_CONFIRM_REQUEST" message next ctx
+ with _ ->
+ errorResponse 500 "PERSISTENCE_ERROR" "redemption confirmation failed" next ctx
+
let private marketDataError (failure: MarketDataFailure) : HttpHandler =
let status, error, message =
match failure with
@@ -579,6 +719,9 @@ module App =
POST >=> routef "/funds/%s/orders" (createOrder repository)
GET >=> routef "/funds/%s/orders" (getOrders repository)
POST >=> routef "/funds/%s/orders/%s/confirm" (fun (fundId, orderId) -> confirmOrder repository fundId orderId)
+ POST >=> routef "/funds/%s/redemptions" (createRedemption repository)
+ GET >=> routef "/funds/%s/redemptions" (getRedemptions repository)
+ POST >=> routef "/funds/%s/redemptions/%s/confirm" (fun (fundId, orderId) -> confirmRedemption repository fundId orderId)
GET >=> routef "/funds/%s/positions" (getPositions repository)
GET >=> routef "/funds/%s" (getFund repository)
]