From 722ec6c19c0c64ea5348c6bc3aefc0061bd96307 Mon Sep 17 00:00:00 2001 From: "Somhairle H. Marisol" Date: Mon, 21 Sep 2026 21:47:59 +0800 Subject: Add dividend slice (3d-8) Book cash dividends to available cash exactly once and reinvest dividends through the shared subscription pipeline, with deterministic scheme idempotency and cross-position isolation. --- src/FundLab.Api/App.fs | 116 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) (limited to 'src/FundLab.Api/App.fs') diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs index 4ae00de..b5b2064 100644 --- a/src/FundLab.Api/App.fs +++ b/src/FundLab.Api/App.fs @@ -148,6 +148,24 @@ type SipPlanResponse = createdAt: string } +type DividendResponse = + { + id: Guid + fundId: Guid + instrumentCode: string + navDate: string + dps: string + mode: string + status: string + grossCash: string option + creditedUnits: string option + creditedInvested: string option + orderId: string option + pendingReason: string option + isSynthetic: bool + createdAt: string + } + type RebalancePlanResponse = { id: Guid @@ -560,8 +578,104 @@ module App = with | :? JsonException -> Error "request body must be valid JSON" + let private parseDividendCommand (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 "navDate", tryStringProperty root "dps", tryStringProperty root "mode" with + | Some code, Some navDateText, Some dpsText, Some modeText -> + match tryDecimal "dps" dpsText, DividendPolicy.parseMode modeText, DateOnly.TryParseExact(navDateText, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with + | Ok dps, Some mode, (true, navDate) -> + Ok + { + InstrumentCode = code + NavDate = navDate + Dps = dps + Mode = mode + } + | Error message, _, _ -> Error message + | _, None, _ -> Error "mode must be cash or reinvest" + | _, _, (false, _) -> Error "navDate must be yyyy-MM-dd" + | _ -> + Error "instrumentCode, navDate, dps and mode are required" + with + | :? JsonException -> Error "request body must be valid JSON" + + let private dividendResponse (record: DividendRecord) : DividendResponse = + { + id = record.Id + fundId = record.FundId + instrumentCode = record.InstrumentCode + navDate = dateText record.NavDate + dps = decimalText record.Dps + mode = DividendPolicy.modeText record.Mode + status = record.Status + grossCash = record.GrossCash |> Option.map cashText + creditedUnits = record.CreditedUnits |> Option.map decimalText + creditedInvested = record.CreditedInvested |> Option.map cashText + orderId = record.OrderId |> Option.map (fun id -> id.ToString("D")) + pendingReason = record.PendingReason + isSynthetic = record.IsSynthetic + createdAt = timestampText record.CreatedAt + } + let private invokeHandler handler next ctx = handler next ctx + let private createDividend (repository: FundRepository) (fundIdText: string) : HttpHandler = + fun next ctx -> + task { + match Guid.TryParse fundIdText with + | false, _ -> + return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_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 parseDividendCommand body with + | Error message -> + return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_REQUEST" message) next ctx + | Ok command -> + try + match repository.RegisterDividend(idempotencyKey, fundId, command) with + | DividendWriteResult.DividendCredited record + | DividendWriteResult.DividendReplayed record -> + return! invokeHandler (json (dividendResponse record)) next ctx + | DividendWriteResult.DividendPendingReinvest record -> + return! invokeHandler (json (dividendResponse record)) next ctx + | DividendWriteResult.DividendIdempotencyConflict -> + return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "dividend scheme already registered with a different amount") next ctx + | DividendWriteResult.DividendInvalid message -> + return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_REQUEST" message) next ctx + | DividendWriteResult.DividendFundNotFound -> + return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx + | DividendWriteResult.DividendInstrumentNotFound -> + return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx + | DividendWriteResult.DividendNoHoldings -> + return! invokeHandler (errorResponse 409 "NO_HOLDINGS" "the instrument has no confirmed holdings to receive the dividend") next ctx + with _ -> + return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "dividend persistence failed") next ctx + } + + let private getDividends (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 records = repository.GetDividendRecords fundId + json (records |> List.map dividendResponse) next ctx + with _ -> + errorResponse 500 "PERSISTENCE_ERROR" "dividend persistence failed" next ctx + + let private unauthorized : HttpHandler = @@ -1173,6 +1287,8 @@ module App = POST >=> routef "/funds/%s/rebalance/plans" (createRebalancePlan repository) GET >=> routef "/funds/%s/rebalance/plans" (getRebalancePlans repository) POST >=> routef "/funds/%s/rebalance/plans/%s/execute" (fun (fundId, planId) -> executeRebalancePlan repository fundId planId) + POST >=> routef "/funds/%s/dividends" (createDividend repository) + GET >=> routef "/funds/%s/dividends" (getDividends repository) GET >=> routef "/funds/%s" (getFund repository) ] @ (marketData |> Option.map marketDataRoutes |> Option.defaultValue []) -- cgit v1.2.3