summaryrefslogtreecommitdiff
path: root/src/FundLab.Api/Persistence.fs
diff options
context:
space:
mode:
Diffstat (limited to 'src/FundLab.Api/Persistence.fs')
-rw-r--r--src/FundLab.Api/Persistence.fs282
1 files changed, 282 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 22:51:45 +0000