From b8811922f4e167d50efb8817da35a12d8a9d653b Mon Sep 17 00:00:00 2001 From: "Somhairle H. Marisol" Date: Mon, 21 Sep 2026 11:21:51 +0800 Subject: 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. --- src/FundLab.Api/App.fs | 143 +++++++ src/FundLab.Api/Persistence.fs | 689 ++++++++++++++++++++++++++++++- src/FundLab.Domain/FundLab.Domain.fsproj | 1 + src/FundLab.Domain/Redemption.fs | 84 ++++ src/FundLab.Web/App.fs | 449 ++++++++++++++++++++ src/FundLab.Web/src/api.js | 31 ++ 6 files changed, 1391 insertions(+), 6 deletions(-) create mode 100644 src/FundLab.Domain/Redemption.fs (limited to 'src') 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) ] diff --git a/src/FundLab.Api/Persistence.fs b/src/FundLab.Api/Persistence.fs index 6080beb..85396d5 100644 --- a/src/FundLab.Api/Persistence.fs +++ b/src/FundLab.Api/Persistence.fs @@ -202,6 +202,7 @@ type FundPositionRecord = FundId: Guid InstrumentCode: string Units: decimal + ReservedUnits: decimal CostCash: decimal LastConfirmedAt: DateTimeOffset ValuationNav: decimal option @@ -209,6 +210,52 @@ type FundPositionRecord = ValuationCollectedAt: DateTimeOffset option } +type RedemptionCommand = + { + InstrumentCode: string + Units: decimal + FeeAmount: decimal + } + +type RedemptionOrderRecord = + { + Id: Guid + FundId: Guid + InstrumentCode: string + Units: decimal + FeeAmount: decimal + Status: string + IsSynthetic: bool + SubmittedAt: DateTimeOffset + TradeDate: DateOnly + ConfirmIdempotencyKey: string option + PendingReason: string option + ConfirmedAt: DateTimeOffset option + ConfirmedNav: decimal option + ConfirmedNavDate: DateOnly option + ConfirmedProceeds: decimal option + ConfirmedCostReleased: decimal option + } + +type RedemptionWriteResult = + | RedemptionCreated of RedemptionOrderRecord + | RedemptionReplayed of RedemptionOrderRecord + | RedemptionIdempotencyConflict + | RedemptionInvalid of string + | RedemptionFundNotFound + | RedemptionInstrumentNotFound + | RedemptionInsufficientUnits + +type RedemptionConfirmResult = + | RedemptionConfirmed of RedemptionOrderRecord + | RedemptionConfirmReplayed of RedemptionOrderRecord + | RedemptionPendingNav of RedemptionOrderRecord + | RedemptionConfirmIdempotencyConflict + | RedemptionAlreadyConfirmed + | RedemptionOrderNotFound + | RedemptionInvalidStatus + | RedemptionInvalid of string + type FundRepository(connectionString: string) = let cashMaximum = 999999999999999999.99m let unitNavMaximum = 99999999999999999999.99999999m @@ -349,6 +396,43 @@ type FundRepository(connectionString: string) = fund_id uuid NOT NULL REFERENCES funds(id), created_at timestamptz NOT NULL DEFAULT now() ); + + CREATE TABLE IF NOT EXISTS redemption_orders ( + id uuid PRIMARY KEY, + fund_id uuid NOT NULL REFERENCES funds(id), + instrument_code text NOT NULL REFERENCES instruments(code), + units numeric(28, 8) NOT NULL CHECK (units > 0), + fee_amount numeric(20, 2) NOT NULL CHECK (fee_amount >= 0), + status text NOT NULL, + is_synthetic boolean NOT NULL, + submitted_at timestamptz NOT NULL DEFAULT now(), + trade_date date NOT NULL, + confirm_idempotency_key text NULL, + pending_reason text NULL, + confirmed_at timestamptz NULL, + confirmed_nav numeric(28, 8) NULL, + confirmed_nav_date date NULL, + confirmed_proceeds numeric(20, 2) NULL, + confirmed_cost_released numeric(20, 2) NULL + ); + + CREATE TABLE IF NOT EXISTS redemption_order_idempotencies ( + idempotency_key text PRIMARY KEY, + request_hash text NOT NULL, + order_id uuid NOT NULL REFERENCES redemption_orders(id), + fund_id uuid NOT NULL REFERENCES funds(id), + created_at timestamptz NOT NULL DEFAULT now() + ); + + CREATE TABLE IF NOT EXISTS redemption_confirm_idempotencies ( + idempotency_key text PRIMARY KEY, + request_hash text NOT NULL, + order_id uuid NOT NULL REFERENCES redemption_orders(id), + fund_id uuid NOT NULL REFERENCES funds(id), + created_at timestamptz NOT NULL DEFAULT now() + ); + + ALTER TABLE fund_positions ADD COLUMN IF NOT EXISTS reserved_units numeric(28, 8) NOT NULL DEFAULT 0; """ let statusText status = @@ -897,6 +981,173 @@ type FundRepository(connectionString: string) = | FundAlreadyExists fundId -> sprintf "fund %O already exists" fundId | other -> sprintf "%A" other + let redemptionRecordFromReader (reader: DbDataReader) : RedemptionOrderRecord = + { + Id = reader.GetGuid(0) + FundId = reader.GetGuid(1) + InstrumentCode = reader.GetString(2) + Units = reader.GetDecimal(3) + FeeAmount = reader.GetDecimal(4) + Status = reader.GetString(5) + IsSynthetic = reader.GetBoolean(6) + SubmittedAt = reader.GetFieldValue(7) + TradeDate = reader.GetFieldValue(8) + ConfirmIdempotencyKey = readStringOption reader 9 + PendingReason = readStringOption reader 10 + ConfirmedAt = optionalDateTimeOffsetFromReader reader 11 + ConfirmedNav = readDecimalOption reader 12 + ConfirmedNavDate = + if reader.IsDBNull(13) then + None + else + Some(reader.GetFieldValue(13)) + ConfirmedProceeds = readDecimalOption reader 14 + ConfirmedCostReleased = readDecimalOption reader 15 + } + + let redemptionOrderColumns = + """ + SELECT id, fund_id, instrument_code, units, fee_amount, + status, is_synthetic, submitted_at, trade_date, + confirm_idempotency_key, pending_reason, confirmed_at, + confirmed_nav, confirmed_nav_date, confirmed_proceeds, confirmed_cost_released + FROM redemption_orders + """ + + let findRedemptionOrder connection transaction orderId = + use command = + commandWithTransaction connection transaction (redemptionOrderColumns + " WHERE id = @order_id") + + addParameter command "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + + use reader = command.ExecuteReader() + if reader.Read() then Some(redemptionRecordFromReader reader) else None + + let findRedemptionOrderIdempotency connection transaction key = + use command = + commandWithTransaction + connection + transaction + "SELECT request_hash, fund_id, order_id FROM redemption_order_idempotencies WHERE idempotency_key = @idempotency_key" + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + + use reader = command.ExecuteReader() + if reader.Read() then + Some(reader.GetString(0), reader.GetGuid(1), reader.GetGuid(2)) + else + None + + let findRedemptionConfirmIdempotency connection transaction key = + use command = + commandWithTransaction + connection + transaction + "SELECT request_hash, fund_id, order_id FROM redemption_confirm_idempotencies WHERE idempotency_key = @idempotency_key" + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + + use reader = command.ExecuteReader() + if reader.Read() then + Some(reader.GetString(0), reader.GetGuid(1), reader.GetGuid(2)) + else + None + + let insertRedemptionOrder connection transaction (order: RedemptionOrderRecord) = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO redemption_orders + (id, fund_id, instrument_code, units, fee_amount, + status, is_synthetic, trade_date) + VALUES + (@id, @fund_id, @instrument_code, @units, @fee_amount, + @status, @is_synthetic, @trade_date) + RETURNING submitted_at + """ + + addParameter command "id" NpgsqlDbType.Uuid (box order.Id) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box order.FundId) |> ignore + addParameter command "instrument_code" NpgsqlDbType.Text (box order.InstrumentCode) |> ignore + addParameter command "units" NpgsqlDbType.Numeric (box order.Units) |> ignore + addParameter command "fee_amount" NpgsqlDbType.Numeric (box order.FeeAmount) |> ignore + addParameter command "status" NpgsqlDbType.Text (box order.Status) |> ignore + addParameter command "is_synthetic" NpgsqlDbType.Boolean (box order.IsSynthetic) |> ignore + addParameter command "trade_date" NpgsqlDbType.Date (box order.TradeDate) |> ignore + + use reader = command.ExecuteReader() + reader.Read() |> ignore + reader.GetFieldValue(0) + + let insertRedemptionOrderIdempotency connection transaction key requestHash orderId fundId = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO redemption_order_idempotencies (idempotency_key, request_hash, order_id, fund_id) + VALUES (@idempotency_key, @request_hash, @order_id, @fund_id) + """ + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + addParameter command "request_hash" NpgsqlDbType.Text (box requestHash) |> ignore + addParameter command "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + command.ExecuteNonQuery() |> ignore + + let insertRedemptionConfirmIdempotency connection transaction key requestHash orderId fundId = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO redemption_confirm_idempotencies (idempotency_key, request_hash, order_id, fund_id) + VALUES (@idempotency_key, @request_hash, @order_id, @fund_id) + """ + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + addParameter command "request_hash" NpgsqlDbType.Text (box requestHash) |> ignore + addParameter command "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + command.ExecuteNonQuery() |> ignore + + let redemptionRequestHash (fundId: Guid) (command: RedemptionCommand) = + let invariant = CultureInfo.InvariantCulture + let encoded (value: string) = sprintf "%d:%s" value.Length value + let code = if isNull command.InstrumentCode then "" else command.InstrumentCode + let payload = + String.concat + "|" + [ + "redemption-order" + encoded (fundId.ToString("D")) + encoded code + (encoded (command.Units.ToString("G29", invariant))) + (encoded (command.FeeAmount.ToString("G29", invariant))) + ] + + Convert.ToHexString(SHA256.HashData(Encoding.UTF8.GetBytes(payload))) + + let validateRedemptionCommand (command: RedemptionCommand) = + if String.IsNullOrWhiteSpace command.InstrumentCode then + Error "instrument code cannot be empty" + elif command.Units <= 0m then + Error "units must be positive" + elif command.FeeAmount < 0m then + Error "fee amount cannot be negative" + elif Decimal.Round(command.Units, 8) <> command.Units then + Error "units exceed supported precision" + elif Decimal.Round(command.FeeAmount, 2) <> command.FeeAmount then + Error "fee amount exceeds cash precision" + elif command.Units > RedemptionPolicy.unitsMaximum then + Error "units exceed database precision" + elif command.FeeAmount > cashMaximum then + Error "fee amount exceeds database precision" + else + Ok() + member _.EnsureSchema() = use connection = new NpgsqlConnection(connectionString) connection.Open() @@ -1200,6 +1451,431 @@ type FundRepository(connectionString: string) = records |> Seq.toList + member _.CreateRedemptionOrder(idempotencyKey: string, fundId: Guid, command: RedemptionCommand) : RedemptionWriteResult = + if String.IsNullOrWhiteSpace idempotencyKey then + RedemptionWriteResult.RedemptionInvalid "idempotency key cannot be empty" + else + match validateRedemptionCommand command with + | Error message -> RedemptionWriteResult.RedemptionInvalid message + | Ok() -> + let fingerprint = redemptionRequestHash fundId command + use connection = new NpgsqlConnection(connectionString) + connection.Open() + use transaction = connection.BeginTransaction(IsolationLevel.ReadCommitted) + + try + use lockCommand = + commandWithTransaction + connection + (Some transaction) + "SELECT pg_advisory_xact_lock(hashtext(@lock_key))" + + addParameter lockCommand "lock_key" NpgsqlDbType.Text (box idempotencyKey) |> ignore + lockCommand.ExecuteNonQuery() |> ignore + + match findRedemptionOrderIdempotency connection (Some transaction) idempotencyKey with + | Some(existingHash, existingFundId, orderId) + when existingHash = fingerprint && existingFundId = fundId -> + match findRedemptionOrder connection (Some transaction) orderId with + | Some order -> + transaction.Commit() + RedemptionReplayed order + | None -> + transaction.Rollback() + RedemptionWriteResult.RedemptionInvalid "idempotency record references a missing order" + | Some _ -> + transaction.Rollback() + RedemptionIdempotencyConflict + | None -> + match lockFundForOrder connection (Some transaction) fundId with + | None -> + transaction.Rollback() + RedemptionFundNotFound + | Some isSynthetic -> + if instrumentExists connection (Some transaction) command.InstrumentCode then + use freezeCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE fund_positions + SET reserved_units = reserved_units + @units + WHERE fund_id = @fund_id + AND instrument_code = @code + AND units - reserved_units >= @units + """ + + addParameter freezeCommand "units" NpgsqlDbType.Numeric (box command.Units) |> ignore + addParameter freezeCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + addParameter freezeCommand "code" NpgsqlDbType.Text (box command.InstrumentCode) |> ignore + + if freezeCommand.ExecuteNonQuery() = 0 then + transaction.Rollback() + RedemptionInsufficientUnits + else + let submittedAt = DateTimeOffset.UtcNow + let order: RedemptionOrderRecord = + { + Id = Guid.NewGuid() + FundId = fundId + InstrumentCode = command.InstrumentCode + Units = command.Units + FeeAmount = command.FeeAmount + Status = "submitted" + IsSynthetic = isSynthetic + SubmittedAt = submittedAt + TradeDate = ConfirmationPolicy.tradeDateFor submittedAt + ConfirmIdempotencyKey = None + PendingReason = None + ConfirmedAt = None + ConfirmedNav = None + ConfirmedNavDate = None + ConfirmedProceeds = None + ConfirmedCostReleased = None + } + + let submittedAt = insertRedemptionOrder connection (Some transaction) order + insertRedemptionOrderIdempotency connection (Some transaction) idempotencyKey fingerprint order.Id fundId + transaction.Commit() + RedemptionCreated { order with SubmittedAt = submittedAt } + else + transaction.Rollback() + RedemptionInstrumentNotFound + with error -> + try + transaction.Rollback() + with _ -> + () + + raise error + + member _.GetRedemptionOrders(fundId: Guid) = + use connection = new NpgsqlConnection(connectionString) + connection.Open() + + use command = + commandWithTransaction connection None (redemptionOrderColumns + " WHERE fund_id = @fund_id ORDER BY submitted_at DESC, id") + + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + + use reader = command.ExecuteReader() + let records = ResizeArray() + + while reader.Read() do + records.Add(redemptionRecordFromReader reader) + + records |> Seq.toList + + member _.ConfirmRedemptionOrder(idempotencyKey: string, fundId: Guid, orderId: Guid) : RedemptionConfirmResult = + if String.IsNullOrWhiteSpace idempotencyKey then + RedemptionConfirmResult.RedemptionInvalid "idempotency key cannot be empty" + else + use connection = new NpgsqlConnection(connectionString) + connection.Open() + use transaction = connection.BeginTransaction(IsolationLevel.ReadCommitted) + + try + let confirmedAt = DateTimeOffset.UtcNow + let today = ConfirmationPolicy.shanghaiDate confirmedAt + + use lockCommand = + commandWithTransaction + connection + (Some transaction) + "SELECT pg_advisory_xact_lock(hashtext(@lock_key))" + + addParameter lockCommand "lock_key" NpgsqlDbType.Text (box (sprintf "confirm-redemption:%O" orderId)) |> ignore + lockCommand.ExecuteNonQuery() |> ignore + + match findRedemptionOrder connection (Some transaction) orderId with + | None -> + transaction.Rollback() + RedemptionOrderNotFound + | Some order when order.FundId <> fundId -> + transaction.Rollback() + RedemptionOrderNotFound + | Some order -> + if order.Status = "confirmed" then + match order.ConfirmIdempotencyKey with + | Some storedKey when storedKey = idempotencyKey -> + transaction.Commit() + RedemptionConfirmReplayed order + | _ -> + match findRedemptionConfirmIdempotency connection (Some transaction) idempotencyKey with + | Some(_, _, storedOrderId) when storedOrderId = orderId -> + transaction.Commit() + RedemptionConfirmReplayed order + | Some _ -> + transaction.Rollback() + RedemptionConfirmIdempotencyConflict + | None -> + transaction.Rollback() + RedemptionAlreadyConfirmed + elif order.Status <> "submitted" && order.Status <> "pending_nav" then + transaction.Rollback() + RedemptionInvalidStatus + else + match findRedemptionConfirmIdempotency connection (Some transaction) idempotencyKey with + | Some _ -> + transaction.Rollback() + RedemptionConfirmIdempotencyConflict + | None -> + let tradeDate = order.TradeDate + let tradeDateText = tradeDate.ToString("yyyy-MM-dd") + + use quoteCommand = + commandWithTransaction + connection + (Some transaction) + """ + SELECT o.nav, o.nav_date, o.source, o.source_revision, o.source_collected_at, o.published_at, + o.source_payload_hash, o.first_seen_at, e.first_seen_at + FROM fund_nav_observations o + LEFT JOIN fund_nav_observation_evidence e + ON e.instrument_code = o.instrument_code + AND e.nav_date = o.nav_date + AND e.source_payload_hash = o.source_payload_hash + WHERE o.instrument_code = @code AND o.nav_date = @trade_date AND o.nav > 0 + ORDER BY o.source_collected_at DESC, o.published_at DESC NULLS LAST, o.source_revision DESC + LIMIT 1 + """ + + addParameter quoteCommand "code" NpgsqlDbType.Text (box order.InstrumentCode) |> ignore + addParameter quoteCommand "trade_date" NpgsqlDbType.Date (box tradeDate) |> ignore + + use quoteReader = quoteCommand.ExecuteReader() + let quoteFound = quoteReader.Read() + + let selectedQuote = + if quoteFound then + let evidenceFirstSeen = + if quoteReader.IsDBNull(8) then + None + else + Some(quoteReader.GetFieldValue(8)) + + Some + ({ + Nav = quoteReader.GetDecimal(0) + NavDate = quoteReader.GetFieldValue(1) + Source = quoteReader.GetString(2) + Revision = quoteReader.GetString(3) + CollectedAt = quoteReader.GetFieldValue(4) + PublishedAt = + if quoteReader.IsDBNull(5) then + None + else + Some(quoteReader.GetFieldValue(5)) + PayloadHash = quoteReader.GetString(6) + FirstSeenAt = quoteReader.GetFieldValue(7) + }, + evidenceFirstSeen) + else + None + + quoteReader.Close() + + let boundQuote = + match selectedQuote with + | Some(quote, Some firstSeen) -> Some { quote with FirstSeenAt = firstSeen } + | _ -> None + + let deferralReason = + match selectedQuote with + | None -> + Some(sprintf "nav for trade date %s is not available yet" tradeDateText) + | Some(_, evidenceFirstSeen) when evidenceFirstSeen.IsNone -> + Some(sprintf "nav revision for trade date %s has no observation evidence recorded" tradeDateText) + | Some(quote, _) when quote.FirstSeenAt > confirmedAt -> + Some(sprintf "nav revision for trade date %s was first observed after the confirmation attempt" tradeDateText) + | Some(quote, _) -> + ConfirmationPolicy.navDeferralReason + { + Nav = quote.Nav + NavDate = quote.NavDate + CollectedAt = quote.CollectedAt + PublishedAt = quote.PublishedAt + } + tradeDate + today + confirmedAt + + match deferralReason with + | Some reason -> + use pendingCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE redemption_orders + SET status = 'pending_nav', + pending_reason = @reason, + confirm_idempotency_key = NULL, + confirmed_at = NULL, + confirmed_nav = NULL, + confirmed_nav_date = NULL, + confirmed_proceeds = NULL, + confirmed_cost_released = NULL + WHERE id = @order_id + """ + + addParameter pendingCommand "reason" NpgsqlDbType.Text (box reason) |> ignore + addParameter pendingCommand "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + pendingCommand.ExecuteNonQuery() |> ignore + transaction.Commit() + + match findRedemptionOrder connection None orderId with + | Some pendingOrder -> RedemptionPendingNav pendingOrder + | None -> failwith "pending redemption disappeared after confirmation deferral" + | None -> + let nav = boundQuote |> Option.get |> fun quote -> quote.Nav + + use positionCommand = + commandWithTransaction + connection + (Some transaction) + """ + SELECT units, reserved_units, cost_cash + FROM fund_positions + WHERE fund_id = @fund_id AND instrument_code = @code + FOR UPDATE + """ + + addParameter positionCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + addParameter positionCommand "code" NpgsqlDbType.Text (box order.InstrumentCode) |> ignore + + use positionReader = positionCommand.ExecuteReader() + let positionFound = positionReader.Read() + let positionUnits = if positionFound then positionReader.GetDecimal(0) else 0m + let positionReserved = if positionFound then positionReader.GetDecimal(1) else 0m + let positionCost = if positionFound then positionReader.GetDecimal(2) else 0m + positionReader.Close() + + if not positionFound || positionReserved < order.Units then + failwith "frozen units are missing for redemption confirmation" + + match RedemptionPolicy.compute order.Units nav order.FeeAmount positionCost positionUnits with + | Error message -> + use pendingCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE redemption_orders + SET status = 'pending_nav', + pending_reason = @reason + WHERE id = @order_id + """ + + addParameter pendingCommand "reason" NpgsqlDbType.Text (box message) |> ignore + addParameter pendingCommand "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + pendingCommand.ExecuteNonQuery() |> ignore + transaction.Commit() + + match findRedemptionOrder connection None orderId with + | Some pendingOrder -> RedemptionPendingNav pendingOrder + | None -> failwith "pending redemption disappeared after computation failure" + | Ok computation -> + use settlePositionCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE fund_positions + SET units = units - @units, + reserved_units = reserved_units - @units, + cost_cash = cost_cash - @cost_released + WHERE fund_id = @fund_id + AND instrument_code = @code + AND units > @units + AND reserved_units >= @units + AND cost_cash >= @cost_released + """ + + addParameter settlePositionCommand "units" NpgsqlDbType.Numeric (box order.Units) |> ignore + addParameter settlePositionCommand "cost_released" NpgsqlDbType.Numeric (box computation.RedeemedCost) |> ignore + addParameter settlePositionCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + addParameter settlePositionCommand "code" NpgsqlDbType.Text (box order.InstrumentCode) |> ignore + + if settlePositionCommand.ExecuteNonQuery() = 0 then + use deletePositionCommand = + commandWithTransaction + connection + (Some transaction) + """ + DELETE FROM fund_positions + WHERE fund_id = @fund_id + AND instrument_code = @code + AND units = @units + AND reserved_units >= @units + AND cost_cash >= @cost_released + """ + + addParameter deletePositionCommand "units" NpgsqlDbType.Numeric (box order.Units) |> ignore + addParameter deletePositionCommand "cost_released" NpgsqlDbType.Numeric (box computation.RedeemedCost) |> ignore + addParameter deletePositionCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + addParameter deletePositionCommand "code" NpgsqlDbType.Text (box order.InstrumentCode) |> ignore + + if deletePositionCommand.ExecuteNonQuery() = 0 then + failwith "position units changed during redemption confirmation" + + use cashCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE funds + SET available_cash = available_cash + @proceeds + WHERE id = @fund_id + """ + + addParameter cashCommand "proceeds" NpgsqlDbType.Numeric (box computation.Proceeds) |> ignore + addParameter cashCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + + if cashCommand.ExecuteNonQuery() = 0 then + failwith "fund disappeared during redemption confirmation" + + use confirmCommand = + commandWithTransaction + connection + (Some transaction) + """ + UPDATE redemption_orders + SET status = 'confirmed', + pending_reason = NULL, + confirm_idempotency_key = @idempotency_key, + confirmed_at = @confirmed_at, + confirmed_nav = @nav, + confirmed_nav_date = @nav_date, + confirmed_proceeds = @proceeds, + confirmed_cost_released = @cost_released + WHERE id = @order_id + """ + + addParameter confirmCommand "idempotency_key" NpgsqlDbType.Text (box idempotencyKey) |> ignore + addParameter confirmCommand "confirmed_at" NpgsqlDbType.TimestampTz (box confirmedAt) |> ignore + addParameter confirmCommand "nav" NpgsqlDbType.Numeric (box nav) |> ignore + addParameter confirmCommand "nav_date" NpgsqlDbType.Date (box tradeDate) |> ignore + addParameter confirmCommand "proceeds" NpgsqlDbType.Numeric (box computation.Proceeds) |> ignore + addParameter confirmCommand "cost_released" NpgsqlDbType.Numeric (box computation.RedeemedCost) |> ignore + addParameter confirmCommand "order_id" NpgsqlDbType.Uuid (box orderId) |> ignore + confirmCommand.ExecuteNonQuery() |> ignore + + insertRedemptionConfirmIdempotency connection (Some transaction) idempotencyKey "" orderId fundId + transaction.Commit() + + match findRedemptionOrder connection None orderId with + | Some confirmedOrder -> RedemptionConfirmed confirmedOrder + | None -> failwith "confirmed redemption disappeared after commit" + + with error -> + try + transaction.Rollback() + with _ -> + () + + raise error + member _.ConfirmSubscriptionOrder(idempotencyKey: string, fundId: Guid, orderId: Guid) = if String.IsNullOrWhiteSpace idempotencyKey then ConfirmInvalid "idempotency key cannot be empty" @@ -1556,7 +2232,7 @@ type FundRepository(connectionString: string) = connection None """ - SELECT p.instrument_code, p.units, p.cost_cash, p.last_confirmed_at, + SELECT p.instrument_code, p.units, p.reserved_units, p.cost_cash, p.last_confirmed_at, q.nav, q.nav_date, q.source_collected_at FROM fund_positions p LEFT JOIN LATERAL ( @@ -1581,21 +2257,22 @@ type FundRepository(connectionString: string) = while reader.Read() do let valuationNav = - if reader.IsDBNull(4) then None else Some(reader.GetDecimal(4)) + if reader.IsDBNull(5) then None else Some(reader.GetDecimal(5)) let valuationNavDate = - if reader.IsDBNull(5) then None else Some(reader.GetFieldValue(5)) + if reader.IsDBNull(6) then None else Some(reader.GetFieldValue(6)) let valuationCollectedAt = - if reader.IsDBNull(6) then None else Some(reader.GetFieldValue(6)) + if reader.IsDBNull(7) then None else Some(reader.GetFieldValue(7)) records.Add( { FundId = fundId InstrumentCode = reader.GetString(0) Units = reader.GetDecimal(1) - CostCash = reader.GetDecimal(2) - LastConfirmedAt = reader.GetFieldValue(3) + ReservedUnits = reader.GetDecimal(2) + CostCash = reader.GetDecimal(3) + LastConfirmedAt = reader.GetFieldValue(4) ValuationNav = valuationNav ValuationNavDate = valuationNavDate ValuationCollectedAt = valuationCollectedAt diff --git a/src/FundLab.Domain/FundLab.Domain.fsproj b/src/FundLab.Domain/FundLab.Domain.fsproj index 9e46c00..a2c5c24 100644 --- a/src/FundLab.Domain/FundLab.Domain.fsproj +++ b/src/FundLab.Domain/FundLab.Domain.fsproj @@ -8,6 +8,7 @@ + diff --git a/src/FundLab.Domain/Redemption.fs b/src/FundLab.Domain/Redemption.fs new file mode 100644 index 0000000..a3e9188 --- /dev/null +++ b/src/FundLab.Domain/Redemption.fs @@ -0,0 +1,84 @@ +namespace FundLab.Domain + +open System + +module RedemptionPolicy = + let unitsMaximum = 99999999999999999999.99999999m + let cashMaximum = 999999999999999999.99m + + let roundDown (scale: int) (value: decimal) : decimal = + let factor = decimal (pown 10 scale) + Decimal.Truncate(value * factor) / factor + + let validateRequest + (availableUnits: decimal) + (requestedUnits: decimal) + (feeAmount: decimal) + : Result = + if requestedUnits <= 0m then + Error "redemption units must be positive" + elif requestedUnits > unitsMaximum then + Error "redemption units exceed supported precision" + elif requestedUnits > availableUnits then + Error "requested units exceed available holdings" + elif feeAmount < 0m then + Error "redemption fee cannot be negative" + elif feeAmount > cashMaximum then + Error "redemption fee exceeds supported precision" + else + Ok () + + type RedemptionComputation = + { + GrossCash: decimal + Fee: decimal + Proceeds: decimal + RedeemedCost: decimal + } + + let compute + (requestedUnits: decimal) + (unitNav: decimal) + (feeAmount: decimal) + (positionCost: decimal) + (positionUnits: decimal) + : Result = + if unitNav <= 0m then + Error "unit nav must be positive" + elif unitNav < 0.00000001m then + Error "unit nav is below database precision" + elif requestedUnits <= 0m then + Error "redemption units must be positive" + elif positionUnits <= 0m then + Error "position units must be positive" + elif requestedUnits > positionUnits then + Error "redemption units exceed position units" + elif feeAmount < 0m then + Error "redemption fee cannot be negative" + else + let gross = requestedUnits * unitNav + let grossRounded = roundDown 2 gross + + if grossRounded <= 0m then + Error "redemption cash rounds to zero" + elif feeAmount > grossRounded then + Error "redemption fee exceeds redemption value" + else + let proceeds = grossRounded - feeAmount + + if proceeds <= 0m then + Error "redemption proceeds rounds to zero" + else + let redeemedCost = + if requestedUnits = positionUnits then + positionCost + else + roundDown 2 (positionCost * requestedUnits / positionUnits) + + Ok + { + GrossCash = grossRounded + Fee = feeAmount + Proceeds = proceeds + RedeemedCost = redeemedCost + } diff --git a/src/FundLab.Web/App.fs b/src/FundLab.Web/App.fs index 56b5a0c..7eb4469 100644 --- a/src/FundLab.Web/App.fs +++ b/src/FundLab.Web/App.fs @@ -152,6 +152,7 @@ type RawPosition = { instrumentCode: string units: string + reservedUnits: string costCash: string lastConfirmedAt: string valuationNav: obj @@ -159,6 +160,23 @@ type RawPosition = valuationCollectedAt: obj } +type RawRedemption = + { + id: string + instrumentCode: string + units: string + feeAmount: string + status: string + submittedAt: string + tradeDate: string + pendingReason: obj + confirmedAt: obj + confirmedNav: obj + confirmedNavDate: obj + confirmedProceeds: obj + confirmedCostReleased: obj + } + type RawPositions = { availableCash: string @@ -187,6 +205,28 @@ type ConfirmAttempt = orderId: string } +type RedemptionAttempt = + { + idempotencyKey: string + instrumentCode: string + units: string + feeAmount: string + } + +type RedemptionConfirmAttempt = + { + idempotencyKey: string + orderId: string + } + +type CreateRedemptionPayload = + { + idempotencyKey: string + instrumentCode: string + units: string + feeAmount: string + } + type OrderDetail = { id: string @@ -210,12 +250,30 @@ type Position = { instrumentCode: string units: string + reservedUnits: string costCash: string lastConfirmedAt: string valuationNav: string option valuationNavDate: string option } +type RedemptionDetail = + { + id: string + 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 + } + type Positions = { availableCash: string @@ -251,6 +309,15 @@ module Api = [] let getPositions (token: string) (fundId: string) : JS.Promise = jsNative + [] + let createRedemption (token: string) (fundId: string) (payload: CreateRedemptionPayload) : JS.Promise = jsNative + + [] + let getRedemptions (token: string) (fundId: string) : JS.Promise = jsNative + + [] + let confirmRedemption (token: string) (fundId: string) (orderId: string) (idempotencyKey: string) : JS.Promise = jsNative + let decodeOptionalText (raw: obj) : string option = if isNull raw then None @@ -308,6 +375,7 @@ module Api = { instrumentCode = raw.instrumentCode units = raw.units + reservedUnits = raw.reservedUnits costCash = raw.costCash lastConfirmedAt = raw.lastConfirmedAt valuationNav = decodeOptionalText raw.valuationNav @@ -321,6 +389,23 @@ module Api = positions = raw.positions |> Array.map decodePosition |> List.ofArray } + let decodeRedemption (raw: RawRedemption) : RedemptionDetail = + { + id = raw.id + instrumentCode = raw.instrumentCode + units = raw.units + feeAmount = raw.feeAmount + status = raw.status + submittedAt = raw.submittedAt + tradeDate = raw.tradeDate + pendingReason = decodeOptionalText raw.pendingReason + confirmedAt = decodeOptionalText raw.confirmedAt + confirmedNav = decodeOptionalText raw.confirmedNav + confirmedNavDate = decodeOptionalText raw.confirmedNavDate + confirmedProceeds = decodeOptionalText raw.confirmedProceeds + confirmedCostReleased = decodeOptionalText raw.confirmedCostReleased + } + type Model = { token: string @@ -352,6 +437,17 @@ type Model = positions: Positions option positionsSeq: int positionsInFlight: bool + redemptionCode: string + redemptionUnits: string + redemptionFee: string + redemptionCreateSeq: int + redemptionReadSeq: int + redemptionInFlight: bool + lastRedemptionAttempt: RedemptionAttempt option + redemptions: RedemptionDetail list + redemptionConfirmSeq: int + redemptionConfirmInFlight: bool + lastRedemptionConfirmAttempt: RedemptionConfirmAttempt option error: string option } @@ -389,6 +485,18 @@ type Msg = | PositionsReadRequested | PositionsReadCompleted of requestId: int * positions: RawPositions | PositionsReadFailed of requestId: int * message: string + | RedemptionCodeChanged of string + | RedemptionUnitsChanged of string + | RedemptionFeeChanged of string + | RedemptionCreateRequested + | RedemptionCreateCompleted of requestId: int * fundId: string * order: RawRedemption + | RedemptionCreateFailed of requestId: int * fundId: string * message: string + | RedemptionsReadRequested + | RedemptionsReadCompleted of requestId: int * orders: RawRedemption array + | RedemptionsReadFailed of requestId: int * message: string + | RedemptionConfirmRequested of orderId: string + | RedemptionConfirmCompleted of requestId: int * orderId: string * order: RawRedemption + | RedemptionConfirmFailed of requestId: int * orderId: string * message: string let defaultInitialUnitNav = "1.00000000" @@ -449,6 +557,17 @@ let init () = positions = None positionsSeq = 0 positionsInFlight = false + redemptionCode = "" + redemptionUnits = "" + redemptionFee = "" + redemptionCreateSeq = 0 + redemptionReadSeq = 0 + redemptionInFlight = false + lastRedemptionAttempt = None + redemptions = [] + redemptionConfirmSeq = 0 + redemptionConfirmInFlight = false + lastRedemptionConfirmAttempt = None error = None } @@ -521,6 +640,27 @@ let private readPositionsCommand token fundId requestId = (fun positions -> PositionsReadCompleted(requestId, positions)) (fun error -> PositionsReadFailed(requestId, errorText error)) +let private createRedemptionCommand token fundId payload requestId = + Cmd.OfPromise.either + (fun () -> Api.createRedemption token fundId payload) + () + (fun order -> RedemptionCreateCompleted(requestId, fundId, order)) + (fun error -> RedemptionCreateFailed(requestId, fundId, errorText error)) + +let private readRedemptionsCommand token fundId requestId = + Cmd.OfPromise.either + (fun () -> Api.getRedemptions token fundId) + () + (fun orders -> RedemptionsReadCompleted(requestId, orders)) + (fun error -> RedemptionsReadFailed(requestId, errorText error)) + +let private confirmRedemptionCommand token fundId orderId idempotencyKey requestId = + Cmd.OfPromise.either + (fun () -> Api.confirmRedemption token fundId orderId idempotencyKey) + () + (fun order -> RedemptionConfirmCompleted(requestId, orderId, order)) + (fun error -> RedemptionConfirmFailed(requestId, orderId, errorText error)) + let update message model = match message with | TokenChanged token -> @@ -554,6 +694,17 @@ let update message model = positions = None positionsSeq = model.positionsSeq + 1 positionsInFlight = false + redemptionCode = "" + redemptionUnits = "" + redemptionFee = "" + redemptionCreateSeq = model.redemptionCreateSeq + 1 + redemptionReadSeq = model.redemptionReadSeq + 1 + redemptionInFlight = false + lastRedemptionAttempt = None + redemptions = [] + redemptionConfirmSeq = model.redemptionConfirmSeq + 1 + redemptionConfirmInFlight = false + lastRedemptionConfirmAttempt = None error = None }, Cmd.none @@ -713,6 +864,17 @@ let update message model = positions = None positionsSeq = model.positionsSeq + 1 positionsInFlight = false + redemptionCode = "" + redemptionUnits = "" + redemptionFee = "" + redemptionCreateSeq = model.redemptionCreateSeq + 1 + redemptionReadSeq = model.redemptionReadSeq + 1 + redemptionInFlight = false + lastRedemptionAttempt = None + redemptions = [] + redemptionConfirmSeq = model.redemptionConfirmSeq + 1 + redemptionConfirmInFlight = false + lastRedemptionConfirmAttempt = None error = None }, Cmd.ofMsg OrdersReadRequested @@ -907,6 +1069,152 @@ let update message model = { model with positionsInFlight = false; error = Some message }, Cmd.none else model, Cmd.none + | RedemptionCodeChanged value -> + { model with redemptionCode = value; error = None; lastRedemptionAttempt = None }, Cmd.none + | RedemptionUnitsChanged value -> + { model with redemptionUnits = value; error = None; lastRedemptionAttempt = None }, Cmd.none + | RedemptionFeeChanged value -> + { model with redemptionFee = value; error = None; lastRedemptionAttempt = None }, Cmd.none + | RedemptionCreateRequested -> + let code = model.redemptionCode.Trim() + let units = model.redemptionUnits.Trim() + let fee = model.redemptionFee.Trim() + + if String.IsNullOrWhiteSpace model.token then + { model with error = Some "请输入 API token" }, Cmd.none + elif model.createdFund.IsNone then + { model with error = Some "请先创建一个基金" }, Cmd.none + elif code = "" then + { model with error = Some "请输入基金代码" }, Cmd.none + elif Decimal.TryParse(units, NumberStyles.Float, CultureInfo.InvariantCulture) |> fst |> not then + { model with error = Some "赎回份额必须是合法的八位小数份额数，例如 100.00000000" }, Cmd.none + elif Decimal.Parse(units, NumberStyles.Float, CultureInfo.InvariantCulture) <= 0m then + { model with error = Some "赎回份额必须是大于零的八位小数份额数，例如 100.00000000" }, Cmd.none + elif not (isValidCashText fee) || not (isNonNegativeCash fee) then + { model with error = Some "赎回手续费必须是不小于零的两位小数金额，例如 0.00" }, Cmd.none + elif model.redemptionInFlight then + model, Cmd.none + else + let requestId = model.redemptionCreateSeq + 1 + + let idempotencyKey = + match model.lastRedemptionAttempt with + | Some attempt when + attempt.instrumentCode = code + && attempt.units = units + && attempt.feeAmount = fee + -> + attempt.idempotencyKey + | _ -> Guid.NewGuid().ToString("N") + + { + model with + redemptionCode = code + redemptionUnits = units + redemptionFee = fee + redemptionCreateSeq = requestId + redemptionInFlight = true + lastRedemptionAttempt = + Some + { + idempotencyKey = idempotencyKey + instrumentCode = code + units = units + feeAmount = fee + } + error = None + }, + createRedemptionCommand + model.token + model.createdFund.Value.id + { + idempotencyKey = idempotencyKey + instrumentCode = code + units = units + feeAmount = fee + } + requestId + | RedemptionCreateCompleted (requestId, fundId, order) -> + if requestId = model.redemptionCreateSeq + && (match model.createdFund with Some fund -> fund.id = fundId | None -> false) then + { + model with + redemptionInFlight = false + lastRedemptionAttempt = None + error = None + }, + Cmd.batch [ Cmd.ofMsg FundReadRequested; Cmd.ofMsg RedemptionsReadRequested; Cmd.ofMsg PositionsReadRequested ] + else + model, Cmd.none + | RedemptionCreateFailed (requestId, fundId, message) -> + if requestId = model.redemptionCreateSeq + && (match model.createdFund with Some fund -> fund.id = fundId | None -> false) then + { model with redemptionInFlight = false; error = Some message }, Cmd.none + else + model, Cmd.none + | RedemptionsReadRequested -> + match model.createdFund with + | Some fund when not (String.IsNullOrWhiteSpace model.token) -> + let requestId = model.redemptionReadSeq + 1 + + { model with redemptionReadSeq = requestId; error = None }, + readRedemptionsCommand model.token fund.id requestId + | Some _ -> + { model with error = Some "请输入 API token" }, Cmd.none + | None -> + model, Cmd.none + | RedemptionsReadCompleted (requestId, orders) -> + if requestId = model.redemptionReadSeq then + { + model with + redemptions = orders |> Array.map Api.decodeRedemption |> Array.toList + error = None + }, + Cmd.none + else + model, Cmd.none + | RedemptionsReadFailed (requestId, message) -> + if requestId = model.redemptionReadSeq then + { model with error = Some message }, Cmd.none + else + model, Cmd.none + | RedemptionConfirmRequested orderId -> + match model.createdFund with + | Some fund when not (String.IsNullOrWhiteSpace model.token) && not model.redemptionConfirmInFlight -> + let requestId = model.redemptionConfirmSeq + 1 + let idempotencyKey = Guid.NewGuid().ToString("N") + + { + model with + redemptionConfirmSeq = requestId + redemptionConfirmInFlight = true + lastRedemptionConfirmAttempt = Some { idempotencyKey = idempotencyKey; orderId = orderId } + error = None + }, + confirmRedemptionCommand model.token fund.id orderId idempotencyKey requestId + | Some _ when model.redemptionConfirmInFlight -> model, Cmd.none + | Some _ -> { model with error = Some "请输入 API token" }, Cmd.none + | None -> model, Cmd.none + | RedemptionConfirmCompleted (requestId, orderId, raw) -> + if requestId = model.redemptionConfirmSeq + && (model.lastRedemptionConfirmAttempt |> Option.exists (fun attempt -> attempt.orderId = orderId)) then + let confirmed = Api.decodeRedemption raw + + let redemptions = + model.redemptions + |> List.map (fun order -> if order.id = confirmed.id then confirmed else order) + + { model with redemptionConfirmInFlight = false; lastRedemptionConfirmAttempt = None; redemptions = redemptions; error = None }, + Cmd.batch [ Cmd.ofMsg FundReadRequested; Cmd.ofMsg PositionsReadRequested ] + else + model, Cmd.none + | RedemptionConfirmFailed (requestId, orderId, message) -> + if requestId = model.redemptionConfirmSeq + && (model.lastRedemptionConfirmAttempt |> Option.exists (fun attempt -> attempt.orderId = orderId)) then + { model with redemptionConfirmInFlight = false; lastRedemptionConfirmAttempt = None; error = Some message }, + Cmd.ofMsg RedemptionsReadRequested + else + model, Cmd.none let private navText (text: string) = match Decimal.TryParse(text, NumberStyles.Float, CultureInfo.InvariantCulture) with @@ -1386,11 +1694,18 @@ let private positionRow (position: Position) = | Some nav, Some navDate -> sprintf "%s（%s）" nav navDate | _ -> "估值待更新" + let frozen = + if position.reservedUnits <> "0.00000000" then + Html.span [ prop.className "order-cell"; prop.text (sprintf "冻结份额 %s" position.reservedUnits) ] + else + Html.none + Html.div [ prop.className "order-row position-row" prop.children [ Html.span [ prop.className "order-code"; prop.text position.instrumentCode ] Html.span [ prop.className "order-cell"; prop.text (sprintf "份额 %s" position.units) ] + frozen Html.span [ prop.className "order-cell"; prop.text (sprintf "成本 %s" position.costCash) ] Html.span [ prop.className "order-cell"; prop.text (sprintf "最新估值净值 %s" valuation) ] Html.span [ prop.className "order-cell"; prop.text (sprintf "最近确认 %s" position.lastConfirmedAt) ] @@ -1443,6 +1758,139 @@ let private positionsPanel model dispatch = ] ] +let private redemptionStatusText (status: string) = + if status = "submitted" then "已提交 · 待确认" + elif status = "pending_nav" then "等待净值" + elif status = "confirmed" then "已确认" + else status + +let private redemptionRow (order: RedemptionDetail) model dispatch = + let confirmButton = + if order.status = "submitted" || order.status = "pending_nav" then + Html.button [ + prop.className "secondary-action redemption-confirm-action" + prop.disabled model.redemptionConfirmInFlight + prop.onClick (fun _ -> dispatch (RedemptionConfirmRequested order.id)) + prop.text (if model.redemptionConfirmInFlight then "确认中..." else "确认赎回") + ] + else + Html.none + + let detailText = + match order.status with + | "confirmed" -> + [ + sprintf "确认净值 %s" (order.confirmedNav |> Option.defaultValue "—") + sprintf "赎回到账 %s" (order.confirmedProceeds |> Option.defaultValue "—") + sprintf "核销成本 %s" (order.confirmedCostReleased |> Option.defaultValue "—") + sprintf "净值日期 %s" (order.confirmedNavDate |> Option.defaultValue "—") + ] + |> String.concat " · " + | "pending_nav" -> + "等待净值 · " + (order.pendingReason |> Option.defaultValue "净值尚未公布") + | _ -> "已冻结份额；净值确认后按交易日结算到账。" + + Html.div [ + prop.className "order-row" + prop.children [ + Html.span [ prop.className "order-code"; prop.text order.instrumentCode ] + Html.span [ prop.className "order-cell"; prop.text (sprintf "份额 %s" order.units) ] + Html.span [ prop.className "order-cell"; prop.text (sprintf "手续费 %s" order.feeAmount) ] + Html.span [ prop.className "order-cell"; prop.text (sprintf "交易日 %s" order.tradeDate) ] + Html.span [ prop.className "order-status"; prop.text (redemptionStatusText order.status) ] + Html.span [ prop.className "order-detail"; prop.text detailText ] + confirmButton + Html.span [ prop.className "order-cell"; prop.text order.submittedAt ] + ] + ] + +let private redeemPanel model dispatch = + Html.section [ + prop.className "panel redeem-panel" + prop.children [ + Html.div [ + prop.className "section-heading" + prop.children [ + Html.div [ + Html.p [ prop.className "eyebrow"; prop.text "06 / REDEEM" ] + Html.h2 "赎回已确认持仓（模拟）" + ] + Html.span [ prop.className "section-note"; prop.text "Pending · units frozen" ] + ] + ] + Html.div [ + prop.className "fund-form-row" + prop.children [ + Html.label [ + prop.className "field-label" + prop.children [ + Html.span "基金代码" + Html.input [ + prop.className "text-input redemption-code-input" + prop.placeholder "六位基金代码" + prop.value model.redemptionCode + prop.onChange (fun value -> dispatch (RedemptionCodeChanged value)) + ] + ] + ] + Html.label [ + prop.className "field-label" + prop.children [ + Html.span "赎回份额" + Html.input [ + prop.className "text-input redemption-units-input" + prop.placeholder "例如 100.00000000" + prop.value model.redemptionUnits + prop.onChange (fun value -> dispatch (RedemptionUnitsChanged value)) + ] + ] + ] + Html.label [ + prop.className "field-label" + prop.children [ + Html.span "赎回手续费（元）" + Html.input [ + prop.className "text-input redemption-fee-input" + prop.placeholder "0.00 或 1.50" + prop.value model.redemptionFee + prop.onChange (fun value -> dispatch (RedemptionFeeChanged value)) + ] + ] + ] + Html.button [ + prop.className "primary-action redemption-submit-action" + prop.disabled model.redemptionInFlight + prop.onClick (fun _ -> dispatch RedemptionCreateRequested) + prop.text ((if model.redemptionInFlight then "赎回中..." else "提交赎回"): string) + ] + ] + ] + Html.p [ + prop.className "hint" + prop.text "份额与手续费按小数字符串提交；提交即冻结对应份额，确认前不产生任何现金变化。" + ] + Html.div [ + prop.className "pending-redemptions" + prop.children [ + if List.isEmpty model.redemptions then + Html.p [ prop.className "hint"; prop.text "暂无赎回订单" ] + else + yield! (model.redemptions |> List.map (fun order -> redemptionRow order model dispatch)) + ] + ] + Html.div [ + prop.className "panel-actions" + prop.children [ + Html.button [ + prop.className "secondary-action redemptions-refresh-action" + prop.onClick (fun _ -> dispatch RedemptionsReadRequested) + prop.text "刷新赎回订单" + ] + ] + ] + ] + ] + let view model dispatch = Html.main [ prop.className "app-shell" @@ -1500,6 +1948,7 @@ let view model dispatch = fundPanel model dispatch subscribePanel model dispatch positionsPanel model dispatch + redeemPanel model dispatch Html.footer [ prop.className "footer-note"; prop.text "SOURCE · AKShare / STORAGE · PostgreSQL / LEDGER · CREATE & READ & SUBSCRIBE" ] ] ] diff --git a/src/FundLab.Web/src/api.js b/src/FundLab.Web/src/api.js index bda8536..743229c 100644 --- a/src/FundLab.Web/src/api.js +++ b/src/FundLab.Web/src/api.js @@ -87,3 +87,34 @@ export function confirmOrder(token, fundId, orderId, idempotencyKey) { export function getPositions(token, fundId) { return requestJson(`/api/funds/${encodeURIComponent(fundId)}/positions`, token); } + +export function createRedemption(token, fundId, payload) { + const body = `{"instrumentCode":${JSON.stringify(payload.instrumentCode)},"units":${JSON.stringify(payload.units)},"feeAmount":${JSON.stringify(payload.feeAmount)}}`; + return requestJson(`/api/funds/${encodeURIComponent(fundId)}/redemptions`, token, { + method: "POST", + headers: { + "Content-Type": "application/json", + "Idempotency-Key": payload.idempotencyKey + }, + body + }); +} + +export function getRedemptions(token, fundId) { + return requestJson(`/api/funds/${encodeURIComponent(fundId)}/redemptions`, token); +} + +export function confirmRedemption(token, fundId, orderId, idempotencyKey) { + return requestJson( + `/api/funds/${encodeURIComponent(fundId)}/redemptions/${encodeURIComponent(orderId)}/confirm`, + token, + { + method: "POST", + headers: { + "Content-Type": "application/json", + "Idempotency-Key": idempotencyKey + }, + body: "{}" + } + ); +} -- cgit v1.2.3