diff options
Diffstat (limited to 'src/FundLab.Api')
| -rw-r--r-- | src/FundLab.Api/App.fs | 143 | ||||
| -rw-r--r-- | src/FundLab.Api/Persistence.fs | 689 |
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 |