diff options
Diffstat (limited to 'src/FundLab.Web/App.fs')
| -rw-r--r-- | src/FundLab.Web/App.fs | 449 |
1 files changed, 449 insertions, 0 deletions
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" ] ] ] |