summaryrefslogtreecommitdiff
path: root/src/FundLab.Api
diff options
context:
space:
mode:
authorSomhairle H. Marisol <[email protected]>2026-09-21 11:21:51 +0800
committerSomhairle H. Marisol <[email protected]>2026-09-21 11:21:51 +0800
commitb8811922f4e167d50efb8817da35a12d8a9d653b (patch)
treeb85cc56677be5d4d58ad2277f00cbc935933301e /src/FundLab.Api
parent3d9398234a54774544eb48a1caed6a1b2d5132eb (diff)
downloadfund-lab-b8811922f4e167d50efb8817da35a12d8a9d653b.tar.gz
Add redemption order minimal closed loop (3d-3)
Redeem confirmed holdings end to end with exact decimal semantics: submission freezes position units (reserved_units) after an available-units check without touching cash, confirmation settles at the trade-date NAV with evidence and deferral rules identical to subscriptions, credits the fund with proceeds net of the stated fee, and writes off position cost pro rata (full redemption removes the position row). Cash conservation holds at every step: frozen shares and receivable cash never appear as available cash before settlement. Domain gains RedemptionPolicy (request validation plus proceeds/fee/ cost-release computation) with unit tests. Persistence adds redemption_orders, idempotency tables, reserved_units on positions and Create/Confirm repository members; the API exposes POST/GET /funds/{id}/redemptions and POST .../confirm. The frontend adds a 06/REDEEM panel (submit, confirm, pending reasons, confirmed proceeds/cost display), frozen-share display on the holdings panel, and refresh wiring. Browser QA gains a K-series covering freeze, settlement, cash accounting, replay and over-redemption rejection.
Diffstat (limited to 'src/FundLab.Api')
-rw-r--r--src/FundLab.Api/App.fs143
-rw-r--r--src/FundLab.Api/Persistence.fs689
2 files changed, 826 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