diff options
Diffstat (limited to 'src/FundLab.Api')
| -rw-r--r-- | src/FundLab.Api/App.fs | 89 | ||||
| -rw-r--r-- | src/FundLab.Api/Persistence.fs | 233 |
2 files changed, 322 insertions, 0 deletions
diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs index 9712fc6..55a29f4 100644 --- a/src/FundLab.Api/App.fs +++ b/src/FundLab.Api/App.fs @@ -131,6 +131,16 @@ type FundPositionsResponse = positions: FundPositionResponse list } +type CapitalDepositResponse = + { + id: Guid + fundId: Guid + amount: string + note: string option + isSynthetic: bool + createdAt: string + } + type ApiErrorResponse = { error: string @@ -261,6 +271,16 @@ module App = isSynthetic = order.IsSynthetic } + let private capitalDepositResponse (deposit: CapitalDepositRecord) : CapitalDepositResponse = + { + id = deposit.Id + fundId = deposit.FundId + amount = cashText deposit.Amount + note = deposit.Note + isSynthetic = deposit.IsSynthetic + createdAt = timestampText deposit.CreatedAt + } + let private errorResponse status error message : HttpHandler = setStatusCode status >=> json ({ @@ -369,6 +389,28 @@ module App = with | :? JsonException -> Error "request body must be valid JSON" + let private parseCapitalDepositCommand (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 "amount" with + | None -> Error "amount is required" + | Some amountText -> + match tryDecimal "amount" amountText with + | Error message -> Error message + | Ok amount -> + Ok + { + Amount = amount + Note = tryStringProperty root "note" + } + with + | :? JsonException -> Error "request body must be valid JSON" + let private invokeHandler handler next ctx = handler next ctx let private unauthorized : HttpHandler = @@ -621,6 +663,51 @@ module App = with _ -> errorResponse 500 "PERSISTENCE_ERROR" "redemption confirmation failed" next ctx + + let private createCapitalDeposit (repository: FundRepository) (fundIdText: string) : HttpHandler = + fun next ctx -> + task { + match Guid.TryParse fundIdText with + | false, _ -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_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 parseCapitalDepositCommand body with + | Error message -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_REQUEST" message) next ctx + | Ok command -> + try + match repository.CreateCapitalDeposit(idempotencyKey, fundId, command) with + | CapitalDepositWriteResult.CapitalDepositCreated deposit -> + return! invokeHandler (setStatusCode 201 >=> json (capitalDepositResponse deposit)) next ctx + | CapitalDepositWriteResult.CapitalDepositReplayed deposit -> + return! invokeHandler (json (capitalDepositResponse deposit)) next ctx + | CapitalDepositWriteResult.CapitalDepositIdempotencyConflict -> + return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx + | CapitalDepositWriteResult.CapitalDepositInvalid message -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_REQUEST" message) next ctx + | CapitalDepositWriteResult.CapitalDepositFundNotFound -> + return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx + with _ -> + return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "capital deposit persistence failed") next ctx + } + + let private getCapitalDeposits (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 deposits = repository.GetCapitalDeposits fundId + json (deposits |> List.map capitalDepositResponse) next ctx + with _ -> + errorResponse 500 "PERSISTENCE_ERROR" "capital deposit persistence failed" next ctx let private marketDataError (failure: MarketDataFailure) : HttpHandler = let status, error, message = match failure with @@ -723,6 +810,8 @@ module App = 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) + POST >=> routef "/funds/%s/capital/deposit" (createCapitalDeposit repository) + GET >=> routef "/funds/%s/capital/deposits" (getCapitalDeposits 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 85396d5..444f578 100644 --- a/src/FundLab.Api/Persistence.fs +++ b/src/FundLab.Api/Persistence.fs @@ -256,6 +256,29 @@ type RedemptionConfirmResult = | RedemptionInvalidStatus | RedemptionInvalid of string +type CapitalDepositCommand = + { + Amount: decimal + Note: string option + } + +type CapitalDepositRecord = + { + Id: Guid + FundId: Guid + Amount: decimal + Note: string option + IsSynthetic: bool + CreatedAt: DateTimeOffset + } + +type CapitalDepositWriteResult = + | CapitalDepositCreated of CapitalDepositRecord + | CapitalDepositReplayed of CapitalDepositRecord + | CapitalDepositIdempotencyConflict + | CapitalDepositInvalid of string + | CapitalDepositFundNotFound + type FundRepository(connectionString: string) = let cashMaximum = 999999999999999999.99m let unitNavMaximum = 99999999999999999999.99999999m @@ -433,6 +456,23 @@ type FundRepository(connectionString: string) = ); ALTER TABLE fund_positions ADD COLUMN IF NOT EXISTS reserved_units numeric(28, 8) NOT NULL DEFAULT 0; + + CREATE TABLE IF NOT EXISTS fund_capital_deposits ( + id uuid PRIMARY KEY, + fund_id uuid NOT NULL REFERENCES funds(id), + amount numeric(20, 2) NOT NULL CHECK (amount > 0), + note text NULL, + is_synthetic boolean NOT NULL, + created_at timestamptz NOT NULL DEFAULT now() + ); + + CREATE TABLE IF NOT EXISTS fund_capital_idempotencies ( + idempotency_key text PRIMARY KEY, + request_hash text NOT NULL, + deposit_id uuid NOT NULL REFERENCES fund_capital_deposits(id), + fund_id uuid NOT NULL REFERENCES funds(id), + created_at timestamptz NOT NULL DEFAULT now() + ); """ let statusText status = @@ -1148,6 +1188,103 @@ type FundRepository(connectionString: string) = else Ok() + let capitalDepositRecordFromReader (reader: DbDataReader) : CapitalDepositRecord = + { + Id = reader.GetGuid(0) + FundId = reader.GetGuid(1) + Amount = reader.GetDecimal(2) + Note = readStringOption reader 3 + IsSynthetic = reader.GetBoolean(4) + CreatedAt = reader.GetFieldValue<DateTimeOffset>(5) + } + + let findCapitalDeposit connection transaction depositId = + use command = + commandWithTransaction + connection + transaction + "SELECT id, fund_id, amount, note, is_synthetic, created_at FROM fund_capital_deposits WHERE id = @deposit_id" + + addParameter command "deposit_id" NpgsqlDbType.Uuid (box depositId) |> ignore + + use reader = command.ExecuteReader() + if reader.Read() then Some(capitalDepositRecordFromReader reader) else None + + let findCapitalDepositIdempotency connection transaction key = + use command = + commandWithTransaction + connection + transaction + "SELECT request_hash, fund_id, deposit_id FROM fund_capital_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 insertCapitalDeposit connection transaction (deposit: CapitalDepositRecord) = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO fund_capital_deposits (id, fund_id, amount, note, is_synthetic) + VALUES (@id, @fund_id, @amount, @note, @is_synthetic) + RETURNING created_at + """ + + addParameter command "id" NpgsqlDbType.Uuid (box deposit.Id) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box deposit.FundId) |> ignore + addParameter command "amount" NpgsqlDbType.Numeric (box deposit.Amount) |> ignore + + let noteParameter = + match deposit.Note with + | Some note -> box note + | None -> box DBNull.Value + + addParameter command "note" NpgsqlDbType.Text noteParameter |> ignore + addParameter command "is_synthetic" NpgsqlDbType.Boolean (box deposit.IsSynthetic) |> ignore + + use reader = command.ExecuteReader() + reader.Read() |> ignore + reader.GetFieldValue<DateTimeOffset>(0) + + let insertCapitalDepositIdempotency connection transaction key requestHash depositId fundId = + use command = + commandWithTransaction + connection + transaction + """ + INSERT INTO fund_capital_idempotencies (idempotency_key, request_hash, deposit_id, fund_id) + VALUES (@idempotency_key, @request_hash, @deposit_id, @fund_id) + """ + + addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore + addParameter command "request_hash" NpgsqlDbType.Text (box requestHash) |> ignore + addParameter command "deposit_id" NpgsqlDbType.Uuid (box depositId) |> ignore + addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + command.ExecuteNonQuery() |> ignore + + let capitalDepositRequestHash (fundId: Guid) (command: CapitalDepositCommand) = + let invariant = CultureInfo.InvariantCulture + let encoded (value: string) = sprintf "%d:%s" value.Length value + let note = if command.Note.IsNone then "" else command.Note.Value + + let payload = + String.concat + "|" + [ + "capital-deposit" + encoded (fundId.ToString("D")) + (encoded (command.Amount.ToString("G29", invariant))) + (encoded note) + ] + + Convert.ToHexString(SHA256.HashData(Encoding.UTF8.GetBytes(payload))) + member _.EnsureSchema() = use connection = new NpgsqlConnection(connectionString) connection.Open() @@ -1451,6 +1588,102 @@ type FundRepository(connectionString: string) = records |> Seq.toList + member _.CreateCapitalDeposit(idempotencyKey: string, fundId: Guid, command: CapitalDepositCommand) : CapitalDepositWriteResult = + if String.IsNullOrWhiteSpace idempotencyKey then + CapitalDepositWriteResult.CapitalDepositInvalid "idempotency key cannot be empty" + else + match CapitalPolicy.validateDeposit command.Amount with + | Error message -> CapitalDepositWriteResult.CapitalDepositInvalid message + | Ok() -> + let fingerprint = capitalDepositRequestHash 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 findCapitalDepositIdempotency connection (Some transaction) idempotencyKey with + | Some(existingHash, existingFundId, depositId) + when existingHash = fingerprint && existingFundId = fundId -> + match findCapitalDeposit connection (Some transaction) depositId with + | Some deposit -> + transaction.Commit() + CapitalDepositWriteResult.CapitalDepositReplayed deposit + | None -> + transaction.Rollback() + CapitalDepositWriteResult.CapitalDepositInvalid "idempotency record references a missing deposit" + | Some _ -> + transaction.Rollback() + CapitalDepositWriteResult.CapitalDepositIdempotencyConflict + | None -> + match lockFundForOrder connection (Some transaction) fundId with + | None -> + transaction.Rollback() + CapitalDepositWriteResult.CapitalDepositFundNotFound + | Some isSynthetic -> + use cashCommand = + commandWithTransaction + connection + (Some transaction) + "UPDATE funds SET available_cash = available_cash + @amount WHERE id = @fund_id" + + addParameter cashCommand "amount" NpgsqlDbType.Numeric (box command.Amount) |> ignore + addParameter cashCommand "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore + + if cashCommand.ExecuteNonQuery() = 0 then + transaction.Rollback() + CapitalDepositWriteResult.CapitalDepositFundNotFound + else + let deposit: CapitalDepositRecord = + { + Id = Guid.NewGuid() + FundId = fundId + Amount = command.Amount + Note = command.Note + IsSynthetic = isSynthetic + CreatedAt = DateTimeOffset.UtcNow + } + + let createdAt = insertCapitalDeposit connection (Some transaction) deposit + insertCapitalDepositIdempotency connection (Some transaction) idempotencyKey fingerprint deposit.Id fundId + transaction.Commit() + CapitalDepositWriteResult.CapitalDepositCreated { deposit with CreatedAt = createdAt } + with error -> + try + transaction.Rollback() + with _ -> + () + + raise error + + member _.GetCapitalDeposits(fundId: Guid) = + use connection = new NpgsqlConnection(connectionString) + connection.Open() + + use command = + commandWithTransaction + connection + None + "SELECT id, fund_id, amount, note, is_synthetic, created_at FROM fund_capital_deposits 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<CapitalDepositRecord>() + + while reader.Read() do + records.Add(capitalDepositRecordFromReader reader) + + records |> Seq.toList + member _.CreateRedemptionOrder(idempotencyKey: string, fundId: Guid, command: RedemptionCommand) : RedemptionWriteResult = if String.IsNullOrWhiteSpace idempotencyKey then RedemptionWriteResult.RedemptionInvalid "idempotency key cannot be empty" |