summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/FundLab.Api/App.fs148
-rw-r--r--src/FundLab.Api/FundLab.Api.fsproj2
-rw-r--r--src/FundLab.Api/Persistence.fs282
-rw-r--r--src/FundLab.Api/Program.fs10
4 files changed, 436 insertions, 6 deletions
diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs
index 44628ab..0eb367d 100644
--- a/src/FundLab.Api/App.fs
+++ b/src/FundLab.Api/App.fs
@@ -1,6 +1,9 @@
namespace FundLab.Api
open System
+open System.Globalization
+open System.IO
+open System.Text.Json
open Giraffe
open Microsoft.AspNetCore.Http
@@ -10,7 +13,103 @@ type EmptyPortfolioResponse =
message: string
}
+type FundApiResponse =
+ {
+ id: Guid
+ name: string
+ currency: string
+ initialCash: string
+ initialUnitNav: string
+ isSynthetic: bool
+ availableCash: string
+ status: string
+ }
+
+type ApiErrorResponse =
+ {
+ error: string
+ message: string
+ }
+
module App =
+ let private invariant = CultureInfo.InvariantCulture
+
+ let private cashText (value: decimal) = value.ToString("0.00", invariant)
+ let private unitNavText (value: decimal) = value.ToString("0.00000000", invariant)
+
+ let private fundResponse (fund: FundRecord) : FundApiResponse =
+ {
+ id = fund.Id
+ name = fund.Name
+ currency = fund.Currency
+ initialCash = cashText fund.InitialCash
+ initialUnitNav = unitNavText fund.InitialUnitNav
+ isSynthetic = fund.IsSynthetic
+ availableCash = cashText fund.AvailableCash
+ status = fund.Status
+ }
+
+ let private errorResponse status error message : HttpHandler =
+ setStatusCode status
+ >=> json ({
+ error = error
+ message = message
+ } : ApiErrorResponse)
+
+ let private tryStringProperty (root: JsonElement) (name: string) =
+ let mutable property = Unchecked.defaultof<JsonElement>
+
+ if root.TryGetProperty(name, &property) && property.ValueKind = JsonValueKind.String then
+ property.GetString() |> Option.ofObj
+ else
+ None
+
+ let private tryBoolProperty (root: JsonElement) (name: string) =
+ let mutable property = Unchecked.defaultof<JsonElement>
+
+ if root.TryGetProperty(name, &property) then
+ match property.ValueKind with
+ | JsonValueKind.True -> Some true
+ | JsonValueKind.False -> Some false
+ | _ -> None
+ else
+ None
+
+ let private tryDecimal (label: string) (text: string) =
+ if String.IsNullOrWhiteSpace text then
+ Error(sprintf "%s must be a decimal string" label)
+ else
+ match Decimal.TryParse(text, NumberStyles.AllowLeadingSign ||| NumberStyles.AllowDecimalPoint, invariant) with
+ | true, value -> Ok value
+ | false, _ -> Error(sprintf "%s must be a decimal string" label)
+
+ let private parseFundCommand (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 "name", tryStringProperty root "initialCash", tryStringProperty root "initialUnitNav", tryBoolProperty root "isSynthetic" with
+ | Some name, Some initialCashText, Some initialUnitNavText, Some isSynthetic ->
+ match tryDecimal "initialCash" initialCashText, tryDecimal "initialUnitNav" initialUnitNavText with
+ | Ok initialCash, Ok initialUnitNav ->
+ Ok {
+ Name = name
+ InitialCash = initialCash
+ InitialUnitNav = initialUnitNav
+ IsSynthetic = isSynthetic
+ }
+ | Error message, _
+ | _, Error message -> Error message
+ | _ ->
+ Error "name, initialCash, initialUnitNav and isSynthetic are required"
+ with
+ | :? JsonException -> Error "request body must be valid JSON"
+
+ let private invokeHandler handler next ctx = handler next ctx
+
let private unauthorized : HttpHandler =
setStatusCode 401
>=> setHttpHeader "WWW-Authenticate" "Bearer"
@@ -35,18 +134,57 @@ module App =
} : HealthResponse)
let private emptyPortfolio : HttpHandler =
- json {
- status = "empty"
- message = "尚未创建基金/尚未选择投资"
- }
+ json ({
+ status = "empty"
+ message = "尚未创建基金/尚未选择投资"
+ } : EmptyPortfolioResponse)
+
+ let private createFund (repository: FundRepository) : HttpHandler =
+ fun next ctx ->
+ task {
+ use reader = new StreamReader(ctx.Request.Body)
+ let! body = reader.ReadToEndAsync()
+ let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString()
+
+ match parseFundCommand body with
+ | Error message ->
+ return! invokeHandler (errorResponse 400 "INVALID_FUND_REQUEST" message) next ctx
+ | Ok command ->
+ try
+ match repository.CreateFund(idempotencyKey, command) with
+ | FundWriteResult.Created fund ->
+ return! invokeHandler (setStatusCode 201 >=> json (fundResponse fund)) next ctx
+ | FundWriteResult.Replayed fund ->
+ return! invokeHandler (json (fundResponse fund)) next ctx
+ | FundWriteResult.IdempotencyConflict ->
+ return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx
+ | FundWriteResult.Invalid message ->
+ return! invokeHandler (errorResponse 400 "INVALID_FUND_REQUEST" message) next ctx
+ with _ ->
+ return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "fund persistence failed") next ctx
+ }
+
+ let private getFund (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
+ | Some fund -> json (fundResponse fund) next ctx
+ | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx
+ with _ ->
+ errorResponse 500 "PERSISTENCE_ERROR" "fund persistence failed" next ctx
- let createApplication () : HttpHandler =
+ let createApplication (repository: FundRepository) : HttpHandler =
choose [
GET >=> route "/health" >=> health
subRoute "/api" (
requireBearer
>=> choose [
GET >=> route "/portfolio/summary" >=> emptyPortfolio
+ POST >=> route "/funds" >=> createFund repository
+ GET >=> routef "/funds/%s" (getFund repository)
]
)
setStatusCode 404 >=> text "Not Found"
diff --git a/src/FundLab.Api/FundLab.Api.fsproj b/src/FundLab.Api/FundLab.Api.fsproj
index 81952df..8a3f590 100644
--- a/src/FundLab.Api/FundLab.Api.fsproj
+++ b/src/FundLab.Api/FundLab.Api.fsproj
@@ -7,6 +7,7 @@
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="6.0.0" />
+ <PackageReference Include="Npgsql" Version="8.0.8" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\FundLab.Domain\FundLab.Domain.fsproj" />
@@ -14,6 +15,7 @@
<ItemGroup>
<Compile Include="Authentication.fs" />
<Compile Include="Health.fs" />
+ <Compile Include="Persistence.fs" />
<Compile Include="App.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
diff --git a/src/FundLab.Api/Persistence.fs b/src/FundLab.Api/Persistence.fs
new file mode 100644
index 0000000..db0fb6f
--- /dev/null
+++ b/src/FundLab.Api/Persistence.fs
@@ -0,0 +1,282 @@
+namespace FundLab.Api
+
+open System
+open System.Data
+open System.Data.Common
+open System.Globalization
+open System.Security.Cryptography
+open System.Text
+open FundLab.Domain
+open Npgsql
+open NpgsqlTypes
+
+[<CLIMutable>]
+type FundCreateCommand =
+ {
+ Name: string
+ InitialCash: decimal
+ InitialUnitNav: decimal
+ IsSynthetic: bool
+ }
+
+type FundRecord =
+ {
+ Id: Guid
+ Name: string
+ Currency: string
+ InitialCash: decimal
+ InitialUnitNav: decimal
+ IsSynthetic: bool
+ AvailableCash: decimal
+ Status: string
+ }
+
+type FundWriteResult =
+ | Created of FundRecord
+ | Replayed of FundRecord
+ | IdempotencyConflict
+ | Invalid of string
+
+type FundRepository(connectionString: string) =
+ let cashMaximum = 999999999999999999.99m
+ let unitNavMaximum = 99999999999999999999.99999999m
+
+ let schema =
+ """
+ CREATE TABLE IF NOT EXISTS funds (
+ id uuid PRIMARY KEY,
+ name text NOT NULL,
+ currency text NOT NULL,
+ initial_cash numeric(20, 2) NOT NULL,
+ initial_unit_nav numeric(28, 8) NOT NULL,
+ is_synthetic boolean NOT NULL,
+ available_cash numeric(20, 2) NOT NULL,
+ status text NOT NULL,
+ created_at timestamptz NOT NULL DEFAULT now()
+ );
+
+ CREATE TABLE IF NOT EXISTS fund_idempotencies (
+ idempotency_key text PRIMARY KEY,
+ request_hash text NOT NULL,
+ fund_id uuid NOT NULL REFERENCES funds(id),
+ created_at timestamptz NOT NULL DEFAULT now()
+ );
+ """
+
+ let statusText status =
+ match status with
+ | FundStatus.Empty -> "empty"
+ | FundStatus.Active -> "active"
+ | FundStatus.ZeroUnits -> "zero_units"
+
+ let recordFromLedger (fund: LedgerFund) =
+ {
+ Id = fund.Id
+ Name = fund.Name
+ Currency = fund.Currency
+ InitialCash = fund.InitialCash
+ InitialUnitNav = fund.InitialUnitNav
+ IsSynthetic = fund.IsSynthetic
+ AvailableCash = fund.AvailableCash
+ Status = statusText fund.Status
+ }
+
+ let recordFromReader (reader: DbDataReader) =
+ {
+ Id = reader.GetGuid(0)
+ Name = reader.GetString(1)
+ Currency = reader.GetString(2)
+ InitialCash = reader.GetDecimal(3)
+ InitialUnitNav = reader.GetDecimal(4)
+ IsSynthetic = reader.GetBoolean(5)
+ AvailableCash = reader.GetDecimal(6)
+ Status = reader.GetString(7)
+ }
+
+ let commandWithTransaction (connection: NpgsqlConnection) (transaction: NpgsqlTransaction option) sql =
+ let command = connection.CreateCommand()
+ command.CommandText <- sql
+
+ match transaction with
+ | Some value -> command.Transaction <- value
+ | None -> ()
+
+ command
+
+ let addParameter (command: NpgsqlCommand) name dbType (value: obj) =
+ let parameter = command.Parameters.Add(name, dbType)
+ parameter.Value <- value
+ parameter
+
+ let findFund connection transaction fundId =
+ use command =
+ commandWithTransaction
+ connection
+ transaction
+ """
+ SELECT id, name, currency, initial_cash, initial_unit_nav,
+ is_synthetic, available_cash, status
+ FROM funds
+ WHERE id = @fund_id
+ """
+
+ addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore
+
+ use reader = command.ExecuteReader()
+ if reader.Read() then Some(recordFromReader reader) else None
+
+ let findIdempotency connection transaction key =
+ use command =
+ commandWithTransaction
+ connection
+ transaction
+ "SELECT request_hash, fund_id FROM fund_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)) else None
+
+ let insertFund connection transaction (fund: LedgerFund) =
+ use command =
+ commandWithTransaction
+ connection
+ transaction
+ """
+ INSERT INTO funds
+ (id, name, currency, initial_cash, initial_unit_nav,
+ is_synthetic, available_cash, status)
+ VALUES
+ (@id, @name, @currency, @initial_cash, @initial_unit_nav,
+ @is_synthetic, @available_cash, @status)
+ """
+
+ addParameter command "id" NpgsqlDbType.Uuid (box fund.Id) |> ignore
+ addParameter command "name" NpgsqlDbType.Text (box fund.Name) |> ignore
+ addParameter command "currency" NpgsqlDbType.Text (box fund.Currency) |> ignore
+ addParameter command "initial_cash" NpgsqlDbType.Numeric (box fund.InitialCash) |> ignore
+ addParameter command "initial_unit_nav" NpgsqlDbType.Numeric (box fund.InitialUnitNav) |> ignore
+ addParameter command "is_synthetic" NpgsqlDbType.Boolean (box fund.IsSynthetic) |> ignore
+ addParameter command "available_cash" NpgsqlDbType.Numeric (box fund.AvailableCash) |> ignore
+ addParameter command "status" NpgsqlDbType.Text (box (statusText fund.Status)) |> ignore
+ command.ExecuteNonQuery() |> ignore
+
+ let insertIdempotency connection transaction key requestHash fundId =
+ use command =
+ commandWithTransaction
+ connection
+ transaction
+ """
+ INSERT INTO fund_idempotencies (idempotency_key, request_hash, fund_id)
+ VALUES (@idempotency_key, @request_hash, @fund_id)
+ """
+
+ addParameter command "idempotency_key" NpgsqlDbType.Text (box key) |> ignore
+ addParameter command "request_hash" NpgsqlDbType.Text (box requestHash) |> ignore
+ addParameter command "fund_id" NpgsqlDbType.Uuid (box fundId) |> ignore
+ command.ExecuteNonQuery() |> ignore
+
+ let requestHash (command: FundCreateCommand) =
+ let invariant = CultureInfo.InvariantCulture
+ let encoded (value: string) = sprintf "%d:%s" value.Length value
+ let name = if isNull command.Name then "" else command.Name
+ let payload =
+ String.concat
+ "|"
+ [
+ "fund-create"
+ encoded name
+ (encoded (command.InitialCash.ToString("G29", invariant)))
+ (encoded (command.InitialUnitNav.ToString("G29", invariant)))
+ (encoded (command.IsSynthetic.ToString()))
+ ]
+
+ Convert.ToHexString(SHA256.HashData(Encoding.UTF8.GetBytes(payload)))
+
+ let validateStorageRange (command: FundCreateCommand) =
+ if command.InitialCash > cashMaximum then
+ Error "initial cash exceeds database precision"
+ elif command.InitialUnitNav > unitNavMaximum then
+ Error "initial unit NAV exceeds database precision"
+ else
+ Ok()
+
+ let ledgerErrorMessage error =
+ match error with
+ | InvalidIdentifier label -> sprintf "%s is invalid" label
+ | InvalidAmount label -> sprintf "%s is invalid" label
+ | InvalidPrecision label -> sprintf "%s has invalid precision" label
+ | InvalidState message -> message
+ | FundAlreadyExists fundId -> sprintf "fund %O already exists" fundId
+ | other -> sprintf "%A" other
+
+ member _.EnsureSchema() =
+ use connection = new NpgsqlConnection(connectionString)
+ connection.Open()
+ use command = connection.CreateCommand()
+ command.CommandText <- schema
+ command.ExecuteNonQuery() |> ignore
+
+ member _.GetFund(fundId: Guid) =
+ use connection = new NpgsqlConnection(connectionString)
+ connection.Open()
+ findFund connection None fundId
+
+ member _.CreateFund(idempotencyKey: string, command: FundCreateCommand) =
+ if String.IsNullOrWhiteSpace idempotencyKey then
+ FundWriteResult.Invalid "idempotency key cannot be empty"
+ else
+ match validateStorageRange command with
+ | Error message -> FundWriteResult.Invalid message
+ | Ok() ->
+ let fingerprint = requestHash 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 findIdempotency connection (Some transaction) idempotencyKey with
+ | Some(existingHash, fundId) when existingHash = fingerprint ->
+ match findFund connection (Some transaction) fundId with
+ | Some fund ->
+ transaction.Commit()
+ FundWriteResult.Replayed fund
+ | None ->
+ transaction.Rollback()
+ FundWriteResult.Invalid "idempotency record references a missing fund"
+ | Some _ ->
+ transaction.Rollback()
+ FundWriteResult.IdempotencyConflict
+ | None ->
+ let fundId = Guid.NewGuid()
+
+ match Ledger.initializeFund fundId command.Name command.InitialCash command.InitialUnitNav command.IsSynthetic Ledger.empty with
+ | Error error ->
+ transaction.Rollback()
+ FundWriteResult.Invalid(ledgerErrorMessage error)
+ | Ok state ->
+ match Ledger.getFund fundId state with
+ | Error error ->
+ transaction.Rollback()
+ FundWriteResult.Invalid(ledgerErrorMessage error)
+ | Ok fund ->
+ insertFund connection (Some transaction) fund
+ insertIdempotency connection (Some transaction) idempotencyKey fingerprint fundId
+ transaction.Commit()
+ FundWriteResult.Created(recordFromLedger fund)
+ with error ->
+ try
+ transaction.Rollback()
+ with _ ->
+ ()
+
+ raise error
diff --git a/src/FundLab.Api/Program.fs b/src/FundLab.Api/Program.fs
index d5cc0b2..4c757d6 100644
--- a/src/FundLab.Api/Program.fs
+++ b/src/FundLab.Api/Program.fs
@@ -1,15 +1,23 @@
module FundLab.Api.Program
+open System
open Giraffe
open Microsoft.AspNetCore.Builder
open Microsoft.Extensions.DependencyInjection
+let private requiredEnvironment name =
+ match Environment.GetEnvironmentVariable(name) with
+ | value when not (String.IsNullOrWhiteSpace value) -> value
+ | _ -> failwithf "%s must be configured" name
+
[<EntryPoint>]
let main argv =
let builder = WebApplication.CreateBuilder(argv)
builder.Services.AddGiraffe() |> ignore
+ let repository = FundRepository(requiredEnvironment "FUND_LAB_DATABASE_URL")
+ repository.EnsureSchema()
let app = builder.Build()
- app.UseGiraffe(App.createApplication())
+ app.UseGiraffe(App.createApplication(repository))
app.Run()
0
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 15:06:10 +0000