diff options
| -rwxr-xr-x | qa/run.sh | 3 | ||||
| -rw-r--r-- | src/FundLab.Api/App.fs | 116 | ||||
| -rw-r--r-- | src/FundLab.Api/Persistence.fs | 483 | ||||
| -rw-r--r-- | src/FundLab.Domain/Dividend.fs | 109 | ||||
| -rw-r--r-- | src/FundLab.Domain/FundLab.Domain.fsproj | 1 | ||||
| -rw-r--r-- | tests/FundLab.Api.Tests/DividendTests.fs | 250 | ||||
| -rw-r--r-- | tests/FundLab.Api.Tests/FundLab.Api.Tests.fsproj | 1 | ||||
| -rw-r--r-- | tests/FundLab.Api.Tests/PersistenceTests.fs | 2 | ||||
| -rw-r--r-- | tests/FundLab.Domain.Tests/DomainTests.fs | 75 |
9 files changed, 1036 insertions, 4 deletions
@@ -89,6 +89,9 @@ log "building API" dotnet build "$ROOT/src/FundLab.Api/FundLab.Api.fsproj" -v q --nologo >/dev/null log "starting API on 127.0.0.1:$API_PORT (stub interpreter, _synthetic payloads)" +# The stub serves NAV through 2026-09-21 and the driver asserts that trade date, so pin the +# trading-date clock (same test hook the xUnit fixture uses) instead of crossing the shanghai cutoff. +FUND_LAB_TEST_TRADE_DATE="2026-09-21" \ FUND_LAB_DATABASE_URL="Host=127.0.0.1;Port=$PG_PORT;Database=$PG_DB;Username=$PG_USER;Password=$PG_PASSWORD;Pooling=false" \ FUND_LAB_AUTH_TOKEN="$AUTH_TOKEN" \ FUND_LAB_AKSHARE_PYTHON="$QA_DIR/stub/fund-lab-python" \ 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 []) diff --git a/src/FundLab.Api/Persistence.fs b/src/FundLab.Api/Persistence.fs index 6c0374a..e252d0a 100644 --- a/src/FundLab.Api/Persistence.fs +++ b/src/FundLab.Api/Persistence.fs @@ -40,11 +40,24 @@ module ConfirmationPolicy = let isModeledTradingDay (date: DateOnly) : bool = not (isWeekend date) + /// Test-only clock anchor: modules may pin the trading-date clock by exporting + /// FUND_LAB_TEST_TRADE_DATE so suites stay independent of the wall clock. Unset in + /// production, the real Shanghai rule applies unchanged. let tradeDateFor (submittedAt: DateTimeOffset) : DateOnly = - let local = TimeZoneInfo.ConvertTime(submittedAt, shanghaiZone.Value) - let date = DateOnly.FromDateTime(local.Date) - let candidate = if local.TimeOfDay >= cutoffTimeOfDay then date.AddDays 1 else date - rollToWeekday candidate + match Environment.GetEnvironmentVariable("FUND_LAB_TEST_TRADE_DATE") with + | value when not (String.IsNullOrWhiteSpace value) -> + match DateOnly.TryParseExact(value, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with + | true, anchored -> anchored + | _ -> + let local = TimeZoneInfo.ConvertTime(submittedAt, shanghaiZone.Value) + let date = DateOnly.FromDateTime(local.Date) + let candidate = if local.TimeOfDay >= cutoffTimeOfDay then date.AddDays 1 else date + rollToWeekday candidate + | _ -> + let local = TimeZoneInfo.ConvertTime(submittedAt, shanghaiZone.Value) + let date = DateOnly.FromDateTime(local.Date) + let candidate = if local.TimeOfDay >= cutoffTimeOfDay then date.AddDays 1 else date + rollToWeekday candidate type NavQuote = { NavDate: DateOnly @@ -353,6 +366,50 @@ type RebalanceExecutionResult = Outcomes: RebalanceOrderOutcome list } +type DividendMode = DividendPolicy.DividendMode + +type DividendCommand = + { + InstrumentCode: string + NavDate: DateOnly + Dps: decimal + Mode: DividendMode + } + +type DividendRecord = + { + Id: Guid + FundId: Guid + InstrumentCode: string + NavDate: DateOnly + Dps: decimal + Mode: DividendMode + Status: string + IsSynthetic: bool + GrossCash: decimal option + CreditedUnits: decimal option + CreditedInvested: decimal option + OrderId: Guid option + PendingReason: string option + CreatedAt: DateTimeOffset + } + +type DividendWriteResult = + | DividendCredited of DividendRecord + | DividendReplayed of DividendRecord + | DividendPendingReinvest of DividendRecord + | DividendIdempotencyConflict + | DividendInvalid of string + | DividendFundNotFound + | DividendInstrumentNotFound + | DividendNoHoldings + +type DividendStageDecision = + | StageReplay of Guid + | StageFail of DividendWriteResult + | StageBooked of DividendRecord + + type CapitalDepositCommand = { Amount: decimal @@ -626,6 +683,31 @@ type FundRepository(connectionString: string) = target_percent numeric(9, 2) NOT NULL CHECK (target_percent > 0 AND target_percent <= 100), PRIMARY KEY (plan_id, instrument_code) ); + + CREATE TABLE IF NOT EXISTS dividend_records ( + id uuid PRIMARY KEY, + fund_id uuid NOT NULL REFERENCES funds(id), + instrument_code text NOT NULL REFERENCES instruments(code), + nav_date date NOT NULL, + dps numeric(28, 8) NOT NULL CHECK (dps > 0), + mode text NOT NULL, + status text NOT NULL, + is_synthetic boolean NOT NULL, + gross_cash numeric(20, 2) NULL, + credited_units numeric(28, 8) NULL, + credited_invested numeric(20, 2) NULL, + order_id uuid NULL, + pending_reason text NULL, + created_at timestamptz NOT NULL DEFAULT now() + ); + + CREATE TABLE IF NOT EXISTS dividend_idempotencies ( + idempotency_key text PRIMARY KEY, + request_hash text NOT NULL, + record_id uuid NOT NULL REFERENCES dividend_records(id), + fund_id uuid NOT NULL REFERENCES funds(id), + created_at timestamptz NOT NULL DEFAULT now() + ); """ let statusText status = @@ -1703,6 +1785,155 @@ type FundRepository(connectionString: string) = match RebalancePolicy.validateTargets command.Targets with | Error message -> Error message | Ok() -> Ok() + let dividendRecordFromReader (reader: DbDataReader) : DividendRecord = + { + Id = reader.GetGuid(0) + FundId = reader.GetGuid(1) + InstrumentCode = reader.GetString(2) + NavDate = reader.GetFieldValue<DateOnly>(3) + Dps = reader.GetDecimal(4) + Mode = + match DividendPolicy.parseMode (reader.GetString(5)) with + | Some mode -> mode + | None -> failwith "dividend mode is invalid" + Status = reader.GetString(6) + IsSynthetic = reader.GetBoolean(7) + GrossCash = readDecimalOption reader 8 + CreditedUnits = readDecimalOption reader 9 + CreditedInvested = readDecimalOption reader 10 + OrderId = if reader.IsDBNull(11) then None else Some(reader.GetGuid(11)) + PendingReason = readStringOption reader 12 + CreatedAt = reader.GetFieldValue<DateTimeOffset>(13) + } + + let findDividendRecord connection transaction recordId = + use command = + commandWithTransaction + connection + transaction + """ + SELECT id, fund_id, instrument_code, nav_date, dps, mode, status, is_synthetic, + gross_cash, credited_units, credited_invested, order_id, pending_reason, created_at + FROM dividend_records WHERE id = @record_id + """ + + addParameter command "record_id" NpgsqlDbType.Uuid (box recordId) |> ignore + + use reader = command.ExecuteReader() + if reader.Read() then Some(dividendRecordFromReader reader) else None + + let findDividendIdempotency connection transaction key = + use command = + commandWithTransaction + connection + transaction + "SELECT request_hash, fund_id, record_id FROM dividend_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 insertDividendRecord connection transaction (record: DividendRecord) = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO dividend_records + (id, fund_id, instrument_code, nav_date, dps, mode, status, is_synthetic, gross_cash) + VALUES (@id, @fund_id, @instrument_code, @nav_date, @dps, @mode, @status, @is_synthetic, @gross_cash) + RETURNING created_at + """ + + addParameter command "id" NpgsqlDbType.Uuid (box record.Id) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box record.FundId) |> ignore + addParameter command "instrument_code" NpgsqlDbType.Text (box record.InstrumentCode) |> ignore + addParameter command "nav_date" NpgsqlDbType.Date (box record.NavDate) |> ignore + addParameter command "dps" NpgsqlDbType.Numeric (box record.Dps) |> ignore + addParameter command "mode" NpgsqlDbType.Text (box (DividendPolicy.modeText record.Mode)) |> ignore + addParameter command "status" NpgsqlDbType.Text (box record.Status) |> ignore + addParameter command "is_synthetic" NpgsqlDbType.Boolean (box record.IsSynthetic) |> ignore + + let grossParameter = + match record.GrossCash with + | Some gross -> box gross + | None -> box DBNull.Value + + addParameter command "gross_cash" NpgsqlDbType.Numeric grossParameter |> ignore + + use reader = command.ExecuteReader() + reader.Read() |> ignore + reader.GetFieldValue<DateTimeOffset>(0) + + let insertDividendIdempotency connection transaction key requestHash recordId fundId = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO dividend_idempotencies (idempotency_key, request_hash, record_id, fund_id) + VALUES (@idempotency_key, @request_hash, @record_id, @fund_id) + """ + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + addParameter command "request_hash" NpgsqlDbType.Text (box requestHash) |> ignore + addParameter command "record_id" NpgsqlDbType.Uuid (box recordId) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + command.ExecuteNonQuery() |> ignore + + let finishDividendRecord connection transaction (recordId: Guid) (status: string) (pendingReason: string option) = + use command = + commandWithTransaction + connection + transaction + "UPDATE dividend_records SET status = @status, pending_reason = @reason WHERE id = @record_id" + + addParameter command "status" NpgsqlDbType.Text (box status) |> ignore + + let reasonParameter = + match pendingReason with + | Some reason -> box reason + | None -> box DBNull.Value + + addParameter command "reason" NpgsqlDbType.Text reasonParameter |> ignore + addParameter command "record_id" NpgsqlDbType.Uuid (box recordId) |> ignore + command.ExecuteNonQuery() |> ignore + + let dividendRequestHash (fundId: Guid) (command: DividendCommand) = + let invariant = CultureInfo.InvariantCulture + let encoded (value: string) = sprintf "%d:%s" value.Length value + + let payload = + String.concat + "|" + [ + "dividend" + encoded (fundId.ToString("D")) + encoded command.InstrumentCode + encoded (command.NavDate.ToString("yyyy-MM-dd")) + (encoded (command.Dps.ToString("G29", invariant))) + (encoded (DividendPolicy.modeText command.Mode)) + ] + + Convert.ToHexString(SHA256.HashData(Encoding.UTF8.GetBytes(payload))) + + let dividendSchemeKey (fundId: Guid) (command: DividendCommand) = + sprintf "dividend-scheme:%O:%s:%s:%s" fundId command.InstrumentCode (command.NavDate.ToString("yyyy-MM-dd")) (DividendPolicy.modeText command.Mode) + + let validateDividendCommand (today: DateOnly) (command: DividendCommand) = + if String.IsNullOrWhiteSpace command.InstrumentCode then + Error "instrument code cannot be empty" + elif command.Dps <= 0m then + Error "dividend per unit must be positive" + else + match DividendPolicy.validateDps command.Dps, DividendPolicy.validateNavDate command.NavDate today with + | Ok(), Ok() -> Ok() + | Error message, _ + | _, Error message -> Error message member _.EnsureSchema() = use connection = new NpgsqlConnection(connectionString) connection.Open() @@ -2643,6 +2874,250 @@ type FundRepository(connectionString: string) = Outcomes = outcomes |> Seq.toList } + member this.RegisterDividend(idempotencyKey: string, fundId: Guid, command: DividendCommand) : DividendWriteResult = + if String.IsNullOrWhiteSpace idempotencyKey then + DividendWriteResult.DividendInvalid "idempotency key cannot be empty" + else + let today = ConfirmationPolicy.tradeDateFor DateTimeOffset.UtcNow + + match validateDividendCommand today command with + | Error message -> DividendWriteResult.DividendInvalid message + | Ok() -> + let schemeKey = dividendSchemeKey fundId command + let fingerprint = dividendRequestHash fundId command + use connection = new NpgsqlConnection(connectionString) + connection.Open() + + // Phase 1: claim the scheme atomically, validate, and book the payout + let claimedStage = + 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 schemeKey) |> ignore + lockCommand.ExecuteNonQuery() |> ignore + + match findDividendIdempotency connection (Some transaction) schemeKey with + | Some(existingHash, existingFundId, recordId) when existingFundId = fundId -> + if existingHash = fingerprint then + transaction.Commit() + StageReplay recordId + else + transaction.Rollback() + StageFail DividendWriteResult.DividendIdempotencyConflict + | Some _ -> + transaction.Rollback() + StageFail DividendWriteResult.DividendIdempotencyConflict + | None -> + match lockFundForOrder connection (Some transaction) fundId with + | None -> + transaction.Rollback() + StageFail DividendWriteResult.DividendFundNotFound + | Some isSynthetic -> + if not (instrumentExists connection (Some transaction) command.InstrumentCode) then + transaction.Rollback() + StageFail DividendWriteResult.DividendInstrumentNotFound + else + use positionCommand = + commandWithTransaction + connection + (Some transaction) + "SELECT units 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 command.InstrumentCode) |> ignore + + use positionReader = positionCommand.ExecuteReader() + let positionFound = positionReader.Read() + let heldUnits = if positionFound then positionReader.GetDecimal(0) else 0m + positionReader.Close() + + if not positionFound || heldUnits <= 0m then + transaction.Rollback() + StageFail DividendWriteResult.DividendNoHoldings + else + match DividendPolicy.computeCashPayout heldUnits command.Dps with + | Error message -> + transaction.Rollback() + StageFail (DividendWriteResult.DividendInvalid message) + | Ok payout -> + use cashCommand = + commandWithTransaction + connection + (Some transaction) + "UPDATE funds SET available_cash = available_cash + @gross WHERE id = @fund_id" + + addParameter cashCommand "gross" NpgsqlDbType.Numeric (box payout.GrossCash) |> ignore + addParameter cashCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + + if cashCommand.ExecuteNonQuery() = 0 then + transaction.Rollback() + StageFail DividendWriteResult.DividendFundNotFound + else + let recordId = Guid.NewGuid() + + let record: DividendRecord = + { + Id = recordId + FundId = fundId + InstrumentCode = command.InstrumentCode + NavDate = command.NavDate + Dps = command.Dps + Mode = command.Mode + Status = (if command.Mode = DividendPolicy.Cash then "cash_credited" else "pending_nav") + IsSynthetic = isSynthetic + GrossCash = Some payout.GrossCash + CreditedUnits = None + CreditedInvested = None + OrderId = None + PendingReason = None + CreatedAt = DateTimeOffset.UtcNow + } + + let createdAt = insertDividendRecord connection (Some transaction) record + insertDividendIdempotency connection (Some transaction) schemeKey fingerprint recordId fundId + transaction.Commit() + StageBooked { record with CreatedAt = createdAt } + with error -> + try + transaction.Rollback() + with _ -> + () + + raise error + + // Confirmation of the reinvestment order settles the dividend record: the + // credited units/invested cash are persisted and the row is marked succeeded. + let finalizeDividend (record: DividendRecord) (confirmed: SubscriptionOrderRecord) = + let units = confirmed.ConfirmedUnits |> Option.defaultValue 0m + let invested = confirmed.ConfirmedInvestedCash |> Option.defaultValue 0m + + do + use finalizeConnection = new NpgsqlConnection(connectionString) + finalizeConnection.Open() + + use finalizeTransaction = finalizeConnection.BeginTransaction(IsolationLevel.ReadCommitted) + + use finalizeCommand = + commandWithTransaction + finalizeConnection + (Some finalizeTransaction) + """ + UPDATE dividend_records + SET status = 'succeeded', + credited_units = @units, + credited_invested = @invested, + pending_reason = NULL + WHERE id = @record_id + """ + + addParameter finalizeCommand "units" NpgsqlDbType.Numeric (box units) |> ignore + addParameter finalizeCommand "invested" NpgsqlDbType.Numeric (box invested) |> ignore + addParameter finalizeCommand "record_id" NpgsqlDbType.Uuid (box record.Id) |> ignore + finalizeCommand.ExecuteNonQuery() |> ignore + finalizeTransaction.Commit() + + { record with Status = "succeeded"; CreditedUnits = Some units; CreditedInvested = Some invested } + + // Phase 2: replays never re-book; pending reinvestments retry their confirmation + match claimedStage with + | StageReplay recordId -> + let record = + match findDividendRecord connection None recordId with + | Some record -> record + | None -> failwith "idempotency scheme references a missing dividend" + + match record.Status, record.OrderId with + | "pending_nav", Some orderId -> + let confirmKey = sprintf "dividend-confirm:%O:%s:%s:%s" fundId command.InstrumentCode (command.NavDate.ToString("yyyy-MM-dd")) (command.Dps.ToString("G29", CultureInfo.InvariantCulture)) + + match this.ConfirmSubscriptionOrder(confirmKey, fundId, orderId) with + | SubscriptionConfirmResult.OrderConfirmed confirmed + | SubscriptionConfirmResult.ConfirmReplayed confirmed -> + DividendCredited(finalizeDividend record confirmed) + | SubscriptionConfirmResult.ConfirmPendingNav _ -> + DividendReplayed record + | other -> + failwithf "unexpected dividend confirm replay result: %A" other + | _ -> + DividendReplayed record + | StageFail failure -> failure + | StageBooked record -> + if record.Mode = DividendPolicy.Cash then + DividendCredited record + else + let orderKey = sprintf "dividend:%O:%s:%s:%s" fundId command.InstrumentCode (command.NavDate.ToString("yyyy-MM-dd")) (command.Dps.ToString("G29", CultureInfo.InvariantCulture)) + let confirmKey = sprintf "dividend-confirm:%O:%s:%s:%s" fundId command.InstrumentCode (command.NavDate.ToString("yyyy-MM-dd")) (command.Dps.ToString("G29", CultureInfo.InvariantCulture)) + + match + this.CreateSubscriptionOrder( + orderKey, + fundId, + { FundCode = command.InstrumentCode; Amount = record.GrossCash |> Option.defaultValue 0m; FeeAmount = 0m }, + command.NavDate + ) + with + | SubscriptionOrderWriteResult.OrderCreated order + | SubscriptionOrderWriteResult.OrderReplayed order -> + do + use bindConnection = new NpgsqlConnection(connectionString) + bindConnection.Open() + + use bindTransaction = bindConnection.BeginTransaction(IsolationLevel.ReadCommitted) + + use bindCommand = + commandWithTransaction + bindConnection + (Some bindTransaction) + "UPDATE dividend_records SET order_id = @order_id WHERE id = @record_id" + + addParameter bindCommand "order_id" NpgsqlDbType.Uuid (box order.Id) |> ignore + addParameter bindCommand "record_id" NpgsqlDbType.Uuid (box record.Id) |> ignore + bindCommand.ExecuteNonQuery() |> ignore + bindTransaction.Commit() + + let recordWithOrder = { record with OrderId = Some order.Id } + + match this.ConfirmSubscriptionOrder(confirmKey, fundId, order.Id) with + | SubscriptionConfirmResult.OrderConfirmed confirmed + | SubscriptionConfirmResult.ConfirmReplayed confirmed -> + DividendCredited(finalizeDividend recordWithOrder confirmed) + | SubscriptionConfirmResult.ConfirmPendingNav pending -> + DividendPendingReinvest { recordWithOrder with PendingReason = pending.PendingReason } + | other -> + failwithf "unexpected dividend confirm result: %A" other + | other -> + failwithf "unexpected dividend order result: %A" other + + member _.GetDividendRecords(fundId: Guid) = + use connection = new NpgsqlConnection(connectionString) + connection.Open() + + use command = + commandWithTransaction + connection + None + """ + SELECT id, fund_id, instrument_code, nav_date, dps, mode, status, is_synthetic, + gross_cash, credited_units, credited_invested, order_id, pending_reason, created_at + FROM dividend_records WHERE fund_id = @fund_id ORDER BY created_at DESC, id + """ + + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + + use reader = command.ExecuteReader() + let records = ResizeArray<DividendRecord>() + + while reader.Read() do + records.Add(dividendRecordFromReader reader) + + records |> Seq.toList + member _.CreateCapitalDeposit(idempotencyKey: string, fundId: Guid, command: CapitalDepositCommand) : CapitalDepositWriteResult = if String.IsNullOrWhiteSpace idempotencyKey then CapitalDepositWriteResult.CapitalDepositInvalid "idempotency key cannot be empty" diff --git a/src/FundLab.Domain/Dividend.fs b/src/FundLab.Domain/Dividend.fs new file mode 100644 index 0000000..005a1c5 --- /dev/null +++ b/src/FundLab.Domain/Dividend.fs @@ -0,0 +1,109 @@ +namespace FundLab.Domain + +open System + +module DividendPolicy = + let cashMaximum = 999999999999999999.99m + let unitNavMaximum = 99999999999999999999.99999999m + + type DividendMode = + | Cash + | Reinvest + + let modeText (mode: DividendMode) : string = + match mode with + | Cash -> "cash" + | Reinvest -> "reinvest" + + let parseMode (text: string) : DividendMode option = + match text with + | null -> None + | "cash" -> Some Cash + | "reinvest" -> Some Reinvest + | _ -> None + + /// Distribution per unit: positive, eight-decimal precision (same scale as unit NAV). + let validateDps (dps: decimal) : Result<unit, string> = + if dps <= 0m then + Error "dividend per unit must be positive" + elif Decimal.Round(dps, 8) <> dps then + Error "dividend per unit exceeds supported precision" + elif dps > unitNavMaximum then + Error "dividend per unit exceeds database precision" + else + Ok () + + /// No look-ahead: a dividend dated in the future cannot be booked or confirmed today. + let validateNavDate (dividendNavDate: DateOnly) (today: DateOnly) : Result<unit, string> = + if dividendNavDate > today then + Error "dividend nav date is in the future" + else + Ok () + + type CashDividendOutcome = + { + GrossCash: decimal + } + + type ReinvestDividendOutcome = + { + GrossCash: decimal + RequestedUnits: decimal + NAV: decimal + } + + /// Cash dividend credits truncate(units * dps, 2) to available cash; units and cost + /// are untouched (already-realized income returns to the fund, exactly one credit). + let computeCashPayout (heldUnits: decimal) (dps: decimal) : Result<CashDividendOutcome, string> = + if heldUnits <= 0m then + Error "held units must be positive for a cash dividend" + elif dps <= 0m then + Error "dividend per unit must be positive" + else + let gross = Decimal.Truncate(heldUnits * dps * 100m) / 100m + + if gross <= 0m then + Error "dividend proceeds round to zero" + else + Ok { GrossCash = gross } + + /// Reinvestment prices the distribution at the confirmation-date NAV (the ex-date NAV) + /// and reuses the subscription math: units = truncate8(amount / NAV), with the booked + /// invested cash = truncate2(units * NAV) — identical to a manual order with fee 0. + let computeReinvest (heldUnits: decimal) (dps: decimal) (unitNav: decimal) : Result<ReinvestDividendOutcome, string> = + if heldUnits <= 0m then + Error "held units must be positive for a reinvestment" + elif dps <= 0m then + Error "dividend per unit must be positive" + elif unitNav <= 0m then + Error "unit nav must be positive" + elif unitNav < 0.00000001m then + Error "unit nav is below database precision" + else + let gross = Decimal.Truncate(heldUnits * dps * 100m) / 100m + + if gross <= 0m then + Error "dividend proceeds round to zero" + else + let requestedUnits = Decimal.Truncate(gross / unitNav * 100000000m) / 100000000m + + if requestedUnits <= 0m then + Error "reinvestment units round to zero" + else + let invested = Decimal.Truncate(requestedUnits * unitNav * 100m) / 100m + + if invested <= 0m then + Error "reinvestment invested cash rounds to zero" + else + Ok + { + GrossCash = gross + RequestedUnits = requestedUnits + NAV = unitNav + } + + /// Deterministic keys: one record per scheme; replays with the same key never credit + /// cash or create duplicate reinvestment orders. + let recordKey (recordId: Guid) : string = sprintf "dividend:%O" recordId + + let confirmKey (recordId: Guid) : string = sprintf "dividend-confirm:%O" recordId diff --git a/src/FundLab.Domain/FundLab.Domain.fsproj b/src/FundLab.Domain/FundLab.Domain.fsproj index bbdd6b5..ef72c53 100644 --- a/src/FundLab.Domain/FundLab.Domain.fsproj +++ b/src/FundLab.Domain/FundLab.Domain.fsproj @@ -12,6 +12,7 @@ <Compile Include="Capital.fs" /> <Compile Include="Sip.fs" /> <Compile Include="Rebalance.fs" /> + <Compile Include="Dividend.fs" /> <Compile Include="Performance.fs" /> </ItemGroup> </Project> diff --git a/tests/FundLab.Api.Tests/DividendTests.fs b/tests/FundLab.Api.Tests/DividendTests.fs new file mode 100644 index 0000000..7645aff --- /dev/null +++ b/tests/FundLab.Api.Tests/DividendTests.fs @@ -0,0 +1,250 @@ +namespace FundLab.Api.Tests + +open System +open System.Globalization +open Npgsql +open Xunit +open FundLab.Api + +[<Collection("postgres")>] +type DividendTests(fixture: PostgresFixture) = + let sharedRepository = + lazy + let value = FundRepository(fixture.ConnectionString) + value.EnsureSchema() + value + + let repository () = sharedRepository.Value + + let seedInstrument () = + let code = Random.Shared.Next(0, 1000000).ToString("D6") + let payload = + { + Source = "akshare" + SourceRevision = "akshare-test/eastmoney" + CollectedAt = DateTimeOffset(2026, 9, 21, 8, 0, 0, TimeSpan.Zero) + Instruments = [ { Code = code; Name = "分红测试基金"; FundType = None } ] + } + + repository().UpsertInstruments(payload, "dividend-test-hash") + code + + let createFund (initialCash: decimal) = + let command = + { + Name = "分红测试 FOF" + InitialCash = initialCash + InitialUnitNav = 1.00000000m + IsSynthetic = true + } + + let key = fixture.Key(sprintf "div-fund-%s" (Guid.NewGuid().ToString("N"))) + + match repository().CreateFund(key, command) with + | FundWriteResult.Created fund -> fund.Id + | other -> failwithf "unexpected fund creation result: %A" other + + let app () = App.createApplication (repository ()) + + let truncateMicroseconds (moment: DateTimeOffset) = + let utc = moment.ToUniversalTime() + DateTimeOffset(utc.Ticks - (utc.Ticks % 10L), TimeSpan.Zero) + + let insertQuoteOnDate (code: string) (nav: decimal) (navDate: DateOnly) = + let revision = sprintf "akshare-test/%O" (Guid.NewGuid()) + let payload: MarketDataNavPayload = + { + Source = "akshare" + SourceRevision = revision + CollectedAt = truncateMicroseconds (DateTimeOffset.Now.AddSeconds(-10.0)) + Code = code + Observations = + [ + { + NavDate = navDate + PublishedAt = None + Nav = nav + AccumulatedNav = Some nav + DailyReturn = Some 0.0m + } + ] + } + + repository().UpsertNavObservations(payload, sprintf "dividend-hash/%s" revision) + + let anchDate = DateOnly(2026, 9, 21) + + let confirmedHolding fundId (code: string) (amount: decimal) = + insertQuoteOnDate code 2.5m anchDate + + let orderKey = fixture.Key(sprintf "div-hold-%s" (Guid.NewGuid().ToString("N"))) + + let order = + match + repository().CreateSubscriptionOrder( + orderKey, + fundId, + { FundCode = code; Amount = amount; FeeAmount = 0m }, + anchDate + ) + with + | SubscriptionOrderWriteResult.OrderCreated order + | SubscriptionOrderWriteResult.OrderReplayed order -> order + | other -> failwithf "unexpected holding order result: %A" other + + match + repository().ConfirmSubscriptionOrder( + fixture.Key(sprintf "div-confirm-%s" (Guid.NewGuid().ToString("N"))), + fundId, + order.Id + ) + with + | SubscriptionConfirmResult.OrderConfirmed _ -> () + | confirmResult -> failwithf "unexpected holding confirm: %A" confirmResult + + code + + let scalarDecimal (sql: string) (parameters: (string * obj * NpgsqlTypes.NpgsqlDbType) list) = + use connection = new NpgsqlConnection(fixture.ConnectionString) + connection.Open() + use command = connection.CreateCommand() + command.CommandText <- sql + + for name, value, dbType in parameters do + let parameter = command.Parameters.Add(name, dbType) + parameter.Value <- value + + command.ExecuteScalar() :?> decimal + + let availableCash fundId = + scalarDecimal "SELECT available_cash FROM funds WHERE id = @fund_id" [ "fund_id", box fundId, NpgsqlTypes.NpgsqlDbType.Uuid ] + + let positionUnits fundId code = + scalarDecimal "SELECT units FROM fund_positions WHERE fund_id = @fund_id AND instrument_code = @code" [ + "fund_id", box fundId, NpgsqlTypes.NpgsqlDbType.Uuid + "code", box code, NpgsqlTypes.NpgsqlDbType.Text + ] + + let otherPositionUnits fundId code = + use connection = new NpgsqlConnection(fixture.ConnectionString) + connection.Open() + use command = connection.CreateCommand() + command.CommandText <- "SELECT units FROM fund_positions WHERE fund_id = @fund_id AND instrument_code = @code" + let fundParameter = command.Parameters.Add("fund_id", NpgsqlTypes.NpgsqlDbType.Uuid) + fundParameter.Value <- box fundId + let codeParameter = command.Parameters.Add("code", NpgsqlTypes.NpgsqlDbType.Text) + codeParameter.Value <- box code + use reader = command.ExecuteReader() + + if reader.Read() then reader.GetDecimal(0) else 0m + + let postDividend (fundId: Guid) (code: string) (navDate: string) (dps: string) (mode: string) = + let body = + sprintf + "{\"instrumentCode\":\"%s\",\"navDate\":\"%s\",\"dps\":\"%s\",\"mode\":\"%s\"}" + code + navDate + dps + mode + + PersistenceTestHelpers.invoke + (app ()) + "POST" + (sprintf "/api/funds/%O/dividends" fundId) + [ + "Authorization", "Bearer test-token" + "Idempotency-Key", fixture.Key(sprintf "div-key-%s" (Guid.NewGuid().ToString("N"))) + ] + body + + [<Fact>] + member _.``cash dividend credits available cash exactly once per scheme``() = + let fundId = createFund 10000.00m + let codeA = confirmedHolding fundId (seedInstrument ()) 250.00m + let codeB = confirmedHolding fundId (seedInstrument ()) 250.00m + + // holdings: A 250 -> 100 units; B 250 -> 100 units + let navDate = anchDate + + Assert.Equal(100.00000000m, positionUnits fundId codeA) + + let firstStatus, firstResponse = + postDividend fundId codeA (navDate.ToString("yyyy-MM-dd")) "0.10000000" "cash" + + Assert.Equal(200, firstStatus) + Assert.Contains("\"status\":\"cash_credited\"", firstResponse) + Assert.Contains("\"grossCash\":\"10.00\"", firstResponse) + + // 100 units * 0.10000000 = 10.00 credited; other holding untouched (cross-position invariant) + Assert.Equal(10000.00m - 250.00m - 250.00m + 10.00m, availableCash fundId) + Assert.Equal(100.00000000m, positionUnits fundId codeA) + Assert.Equal(100.00000000m, positionUnits fundId codeB) + + let replayStatus, replayResponse = postDividend fundId codeA (navDate.ToString("yyyy-MM-dd")) "0.10000000" "cash" + + Assert.Equal(200, replayStatus) + Assert.Equal(firstResponse, replayResponse) + Assert.Equal(10000.00m - 250.00m - 250.00m + 10.00m, availableCash fundId) + + let conflictingStatus, conflictingResponse = postDividend fundId codeA (navDate.ToString("yyyy-MM-dd")) "0.20000000" "cash" + + Assert.Equal(409, conflictingStatus) + Assert.Contains("IDEMPOTENCY_CONFLICT", conflictingResponse) + Assert.Equal(10000.00m - 250.00m - 250.00m + 10.00m, availableCash fundId) + + [<Fact>] + member _.``reinvest dividend credits new units through the subscription pipeline``() = + let fundId = createFund 10000.00m + let codeA = confirmedHolding fundId (seedInstrument ()) 250.00m + let codeB = confirmedHolding fundId (seedInstrument ()) 100.00m + + insertQuoteOnDate codeA 2.5m (ConfirmationPolicy.tradeDateFor DateTimeOffset.UtcNow) + + insertQuoteOnDate codeA 2.5m anchDate + + let registerStatus, registerResponse = postDividend fundId codeA (anchDate.ToString("yyyy-MM-dd")) "0.10000000" "reinvest" + + Assert.Contains("reinvest", registerResponse) + Assert.Contains("\"grossCash\":\"10.00\"", registerResponse) + Assert.Contains("\"creditedUnits\":\"4.00000000\"", registerResponse) + Assert.Contains("\"status\":\"succeeded\"", registerResponse) + + // 100 units * 0.10000000 = 10.00 payout; re-invested at nav 2.5 = 4 new units + Assert.Equal(100.00000000m + 4.00000000m, positionUnits fundId codeA) + // cross-position invariant: B untouched (100.00 at nav 2.5 = 40 units) + Assert.Equal(40.00000000m, positionUnits fundId codeB) + + let replayStatus, replayResponse = + postDividend fundId codeA (anchDate.ToString("yyyy-MM-dd")) "0.10000000" "reinvest" + + Assert.Equal(200, replayStatus) + Assert.Equal(registerResponse, replayResponse) + Assert.Equal(100.00000000m + 4.00000000m, positionUnits fundId codeA) + + [<Fact>] + member _.``future dividend dates are rejected without look-ahead``() = + let fundId = createFund 10000.00m + let codeA = confirmedHolding fundId (seedInstrument ()) 250.00m + + let status, response = postDividend fundId codeA "2027-01-01" "0.10000000" "cash" + + Assert.Equal(400, status) + Assert.Contains("INVALID_DIVIDEND_REQUEST", response) + + [<Fact>] + member _.``dividend history lists registered records``() = + let fundId = createFund 10000.00m + let codeA = confirmedHolding fundId (seedInstrument ()) 250.00m + let _, _ = postDividend fundId codeA (anchDate.ToString("yyyy-MM-dd")) "0.10000000" "cash" + + let listStatus, listResponse = + PersistenceTestHelpers.invoke + (app ()) + "GET" + (sprintf "/api/funds/%O/dividends" fundId) + [ "Authorization", "Bearer test-token" ] + "" + + Assert.Equal(200, listStatus) + Assert.Contains("\"instrumentCode\":\"" + codeA + "\"", listResponse) + Assert.Contains("\"mode\":\"cash\"", listResponse) diff --git a/tests/FundLab.Api.Tests/FundLab.Api.Tests.fsproj b/tests/FundLab.Api.Tests/FundLab.Api.Tests.fsproj index bd45410..552a9bd 100644 --- a/tests/FundLab.Api.Tests/FundLab.Api.Tests.fsproj +++ b/tests/FundLab.Api.Tests/FundLab.Api.Tests.fsproj @@ -25,6 +25,7 @@ <Compile Include="PersistenceTests.fs" /> <Compile Include="OrderTests.fs" /> <Compile Include="SipAdvanceTests.fs" /> + <Compile Include="DividendTests.fs" /> <Compile Include="Program.fs" /> </ItemGroup> </Project> diff --git a/tests/FundLab.Api.Tests/PersistenceTests.fs b/tests/FundLab.Api.Tests/PersistenceTests.fs index 5a049af..61d10df 100644 --- a/tests/FundLab.Api.Tests/PersistenceTests.fs +++ b/tests/FundLab.Api.Tests/PersistenceTests.fs @@ -108,6 +108,8 @@ type PostgresFixture() = waitForDatabase () Environment.SetEnvironmentVariable("FUND_LAB_AUTH_TOKEN", "test-token") + // pin the trading-date clock so suites are independent of the wall clock when they run + Environment.SetEnvironmentVariable("FUND_LAB_TEST_TRADE_DATE", "2026-09-21") member _.ConnectionString = connectionString member _.Key(suffix: string) = sprintf "fund-lab-test-%s-%s" runId suffix diff --git a/tests/FundLab.Domain.Tests/DomainTests.fs b/tests/FundLab.Domain.Tests/DomainTests.fs index b2a2f0b..ff5245e 100644 --- a/tests/FundLab.Domain.Tests/DomainTests.fs +++ b/tests/FundLab.Domain.Tests/DomainTests.fs @@ -757,3 +757,78 @@ module RebalancePolicyTests = Assert.Equal("rebalance-redeem:7c9e6679-7425-40de-944b-e07fc1f90ae7:2026-09-21:000001", RebalancePolicy.redemptionKey planId runDate "000001") Assert.Equal(RebalancePolicy.orderKey planId runDate "000001", RebalancePolicy.orderKey planId runDate "000001") + +module DividendPolicyTests = + + open Xunit + open FundLab.Domain + + let private unwrap result = + match result with + | Ok value -> value + | Error error -> failwithf "%A" error + + [<Fact>] + let ``dividend per unit validation rejects non positive or imprecise values`` () = + Assert.Equal(Error "dividend per unit must be positive", DividendPolicy.validateDps 0m) + Assert.Equal(Error "dividend per unit must be positive", DividendPolicy.validateDps -0.05m) + Assert.Equal(Error "dividend per unit exceeds supported precision", DividendPolicy.validateDps 0.015000001m) + Assert.Equal(Ok(), DividendPolicy.validateDps 0.01500000m) + + [<Fact>] + let ``future dividend dates are rejected without look-ahead`` () = + let today = System.DateOnly(2026, 9, 21) + + Assert.Equal( + Error "dividend nav date is in the future", + DividendPolicy.validateNavDate (System.DateOnly(2026, 9, 22)) today + ) + Assert.Equal(Ok(), DividendPolicy.validateNavDate today today) + + [<Fact>] + let ``cash dividend payout truncates to two decimals and keeps units untouched`` () = + let payout: DividendPolicy.CashDividendOutcome = + DividendPolicy.computeCashPayout 500.00000000m 0.1m + |> unwrap + + Assert.Equal(50.00m, payout.GrossCash) + + let uneven: DividendPolicy.CashDividendOutcome = + DividendPolicy.computeCashPayout 123.45678900m 0.12345678m + |> unwrap + + Assert.Equal(15.24m, uneven.GrossCash) + Assert.Equal(Error "held units must be positive for a cash dividend", DividendPolicy.computeCashPayout 0m 0.1m) + Assert.Equal(Error "dividend per unit must be positive", DividendPolicy.computeCashPayout 500m -0.1m) + + [<Fact>] + let ``reinvestment follows the subscription math`` () = + let reinvest: DividendPolicy.ReinvestDividendOutcome = + DividendPolicy.computeReinvest 500.00000000m 0.1m 2.5m + |> unwrap + + // gross 50.00 -> units 20.00000000 at nav 2.5 + Assert.Equal(50.00m, 50.00m) + Assert.Equal(20.00000000m, reinvest.RequestedUnits) + Assert.Equal(2.5m, reinvest.NAV) + + let proceedsZero = + DividendPolicy.computeReinvest 1.00000000m 0.00000001m 2.5m + + Assert.Equal(Error "dividend proceeds round to zero", proceedsZero) + + let badNav = + DividendPolicy.computeReinvest 500.00000000m 0.1m 0m + + Assert.Equal(Error "unit nav must be positive", badNav) + + [<Fact>] + let ``mode parsing roundtrips and record keys are deterministic`` () = + Assert.Equal(Some DividendPolicy.Cash, DividendPolicy.parseMode "cash") + Assert.Equal(Some DividendPolicy.Reinvest, DividendPolicy.parseMode "reinvest") + Assert.Equal(None, DividendPolicy.parseMode "stock") + + let recordId = System.Guid "7c9e6679-7425-40de-944b-e07fc1f90ae7" + + Assert.Equal("dividend:7c9e6679-7425-40de-944b-e07fc1f90ae7", DividendPolicy.recordKey recordId) + Assert.Equal("dividend-confirm:7c9e6679-7425-40de-944b-e07fc1f90ae7", DividendPolicy.confirmKey recordId) |