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 [] 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