diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/FundLab.Api/App.fs | 143 | ||||
| -rw-r--r-- | src/FundLab.Api/Persistence.fs | 689 | ||||
| -rw-r--r-- | src/FundLab.Domain/FundLab.Domain.fsproj | 1 | ||||
| -rw-r--r-- | src/FundLab.Domain/Redemption.fs | 84 | ||||
| -rw-r--r-- | src/FundLab.Web/App.fs | 449 | ||||
| -rw-r--r-- | src/FundLab.Web/src/api.js | 31 |
6 files changed, 1391 insertions, 6 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) ] 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<DateTimeOffset>(7) + TradeDate = reader.GetFieldValue<DateOnly>(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<DateOnly>(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<DateTimeOffset>(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<RedemptionOrderRecord>() + + 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<DateTimeOffset>(8)) + + Some + ({ + Nav = quoteReader.GetDecimal(0) + NavDate = quoteReader.GetFieldValue<DateOnly>(1) + Source = quoteReader.GetString(2) + Revision = quoteReader.GetString(3) + CollectedAt = quoteReader.GetFieldValue<DateTimeOffset>(4) + PublishedAt = + if quoteReader.IsDBNull(5) then + None + else + Some(quoteReader.GetFieldValue<DateTimeOffset>(5)) + PayloadHash = quoteReader.GetString(6) + FirstSeenAt = quoteReader.GetFieldValue<DateTimeOffset>(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<DateOnly>(5)) + if reader.IsDBNull(6) then None else Some(reader.GetFieldValue<DateOnly>(6)) let valuationCollectedAt = - if reader.IsDBNull(6) then None else Some(reader.GetFieldValue<DateTimeOffset>(6)) + if reader.IsDBNull(7) then None else Some(reader.GetFieldValue<DateTimeOffset>(7)) records.Add( { FundId = fundId InstrumentCode = reader.GetString(0) Units = reader.GetDecimal(1) - CostCash = reader.GetDecimal(2) - LastConfirmedAt = reader.GetFieldValue<DateTimeOffset>(3) + ReservedUnits = reader.GetDecimal(2) + CostCash = reader.GetDecimal(3) + LastConfirmedAt = reader.GetFieldValue<DateTimeOffset>(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 @@ <ItemGroup> <Compile Include="Domain.fs" /> <Compile Include="Ledger.fs" /> + <Compile Include="Redemption.fs" /> <Compile Include="Performance.fs" /> </ItemGroup> </Project> 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<unit, string> = + 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<RedemptionComputation, string> = + 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 = [<Import("getPositions", "./src/api.js")>] let getPositions (token: string) (fundId: string) : JS.Promise<RawPositions> = jsNative + [<Import("createRedemption", "./src/api.js")>] + let createRedemption (token: string) (fundId: string) (payload: CreateRedemptionPayload) : JS.Promise<RawRedemption> = jsNative + + [<Import("getRedemptions", "./src/api.js")>] + let getRedemptions (token: string) (fundId: string) : JS.Promise<RawRedemption array> = jsNative + + [<Import("confirmRedemption", "./src/api.js")>] + let confirmRedemption (token: string) (fundId: string) (orderId: string) (idempotencyKey: string) : JS.Promise<RawRedemption> = 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: "{}" + } + ); +} |