namespace FundLab.Api open System open System.Globalization open System.IO open System.Text.Json open FundLab.Domain open Giraffe open Microsoft.AspNetCore.Http open Microsoft.Extensions.DependencyInjection open Microsoft.FSharp.Reflection type OptionJsonConverter() = inherit Newtonsoft.Json.JsonConverter() override _.CanConvert(objectType: Type) = objectType.IsGenericType && objectType.GetGenericTypeDefinition() = typedefof> override _.WriteJson(writer: Newtonsoft.Json.JsonWriter, value: obj, serializer: Newtonsoft.Json.JsonSerializer) = if isNull value then writer.WriteNull() else let _, fields = FSharpValue.GetUnionFields(value, value.GetType()) match fields with | [| inner |] -> serializer.Serialize(writer, inner) | _ -> writer.WriteNull() override _.ReadJson(reader: Newtonsoft.Json.JsonReader, objectType: Type, existingValue: obj, serializer: Newtonsoft.Json.JsonSerializer) = let cases = FSharpType.GetUnionCases objectType let innerType = objectType.GetGenericArguments().[0] if reader.TokenType = Newtonsoft.Json.JsonToken.Null then FSharpValue.MakeUnion(cases.[0], [||]) else let inner = serializer.Deserialize(reader, innerType) let someCase = cases |> Array.find (fun case -> case.Name = "Some") FSharpValue.MakeUnion(someCase, [| inner |]) type EmptyPortfolioResponse = { status: string message: string } type FundApiResponse = { id: Guid name: string currency: string initialCash: string initialUnitNav: string isSynthetic: bool availableCash: string reservedCash: string status: string } type ConfirmedQuoteEvidenceResponse = { navDate: string nav: string source: string sourceRevision: string sourceCollectedAt: string publishedAt: string option sourcePayloadHash: string firstSeenAt: string } type SubscriptionOrderDetailResponse = { id: Guid fundId: Guid fundCode: string amount: string feeAmount: string reservedTotal: string status: string submittedAt: string tradeDate: string confirmIdempotencyKey: string option pendingReason: string option confirmedAt: string option confirmedNav: string option confirmedNavDate: string option confirmedUnits: string option confirmedInvestedCash: string option confirmedResidualCash: string option quote: ConfirmedQuoteEvidenceResponse option isSynthetic: bool } type FundPositionResponse = { instrumentCode: string units: string reservedUnits: string costCash: string lastConfirmedAt: string valuationNav: string option valuationNavDate: string option 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 availableCash: string reservedCash: string positions: FundPositionResponse list } type StockTradeResponse = { id: Guid fundId: Guid instrumentCode: string stockName: string option quantity: string price: string costCash: string executedAt: string isSynthetic: bool } type StockPositionResponse = { instrumentCode: string stockName: string option quantity: string costCash: string lastTradedAt: string } type StockPositionsResponse = { fundId: Guid positions: StockPositionResponse list } type StockSellResponse = { id: Guid fundId: Guid instrumentCode: string stockName: string option quantity: string price: string feeAmount: string proceeds: string executedAt: string isSynthetic: bool } type BondTradeResponse = { id: Guid fundId: Guid instrumentCode: string bondName: string option quantity: string price: string costCash: string executedAt: string isSynthetic: bool } type BondPositionResponse = { instrumentCode: string bondName: string option quantity: string costCash: string lastTradedAt: string } type BondPositionsResponse = { fundId: Guid positions: BondPositionResponse list } type ValuationPositionResponse = { instrumentCode: string name: string option assetClass: string quantity: string price: string option priceSource: string option marketValue: string option status: string } type FundValuationResponse = { fundId: Guid currency: string asOfDate: string cash: string positionsMarketValue: string portfolioValue: string pricedPositions: int unavailablePositions: int positions: ValuationPositionResponse list } type MarketRefreshTargetResponse = { instrumentCode: string assetClass: string snapshotDate: string price: string } type MarketRefreshFailureResponse = { instrumentCode: string assetClass: string reason: string } type MarketRefreshResponse = { fundId: Guid asOfDate: string refreshed: MarketRefreshTargetResponse list failures: MarketRefreshFailureResponse list } type SipPlanResponse = { id: Guid fundId: Guid instrumentCode: string amount: string frequency: string status: string anchorDate: string nextTradeDate: string lastExecutionStatus: string option lastExecutionDate: string option isSynthetic: bool createdAt: string } type InvestmentPlanResponse = { id: Guid fundId: Guid instrumentCode: string amount: string frequency: string status: string anchorDate: string nextRunDate: string lastRunStatus: string option lastRunDate: string option isSynthetic: bool createdAt: string } type InvestmentPlanRunOutcomeResponse = { runDate: string status: string orderId: string option pendingReason: string option } type InvestmentPlanRunPlanResponse = { planId: Guid instrumentCode: string amount: string frequency: string runs: InvestmentPlanRunOutcomeResponse list nextRunDate: string } type InvestmentPlanRunResponse = { fundId: Guid processingDate: string plans: InvestmentPlanRunPlanResponse list } type DividendResponse = { id: Guid fundId: Guid instrumentCode: string navDate: string dps: string mode: string sourceKey: string status: string grossCash: string option creditedUnits: string option creditedInvested: string option orderId: string option pendingReason: string option isSynthetic: bool createdAt: string } type RebalancePlanResponse = { id: Guid fundId: Guid targets: {| instrumentCode: string; targetPercent: string |} list status: string createdAt: string } type RebalanceExecutionResponse = { planId: Guid runDate: string outcomes: {| instrumentCode: string; action: string; amount: string; status: string; orderId: string option; pendingReason: string option |} list } type RebalanceExecutionRecordResponse = { planId: Guid runDate: string instrumentCode: string action: string amount: string status: string orderId: string option pendingReason: string option executedAt: string } type RebalanceWeightRowResponse = { instrumentCode: string targetPercent: string currentValue: string currentPercent: string action: string deltaAmount: string deltaUnits: string option } type RebalancePreviewResponse = { planId: Guid runDate: string availableCash: string equity: string rows: RebalanceWeightRowResponse list } type CapitalDepositResponse = { id: Guid fundId: Guid amount: string note: string option isSynthetic: bool createdAt: string } type FundReturnsPointResponse = { date: string pending: bool totalAssets: string option unitNav: string option cash: string reservedCash: string holdingsValue: string option cumulativeReturn: string option netExternalFlow: string } type FundReturnsResponse = { fundId: Guid pending: bool dataUpdatedAt: string option points: FundReturnsPointResponse list } type ApiErrorResponse = { error: string message: string } type MarketDataInstrumentApiResponse = { code: string name: string fundType: string option } type MarketDataSearchApiResponse = { source: string sourceRevision: string collectedAt: string instruments: MarketDataInstrumentApiResponse list } type MarketDataObservationApiResponse = { code: string navDate: string publishedAt: string option nav: string accumulatedNav: string option dailyReturn: string option source: string sourceRevision: string sourceCollectedAt: string sourcePayloadHash: string firstSeenAt: string lastSeenAt: string } type MarketDataNavApiResponse = { code: string observations: MarketDataObservationApiResponse list } type MarketNavDatesApiResponse = { code: string dates: string list } type MarketNavSeriesPointApiResponse = { navDate: string nav: string accumulatedNav: string option } type MarketNavSeriesApiResponse = { code: string points: MarketNavSeriesPointApiResponse list } /// The AKShare-backed probes the market endpoints depend on. Injected together /// so the app stays repository-only unless a caller really wants market routes. type MarketProbes = { NavDates: INavDateProbe NavSeries: INavSeriesProbe BondQuotes: IBondQuoteProbe StockQuotes: IStockQuoteProbe StockDaily: IStockDailyProbe } type BondQuoteApiResponse = { code: string sourceRevision: string name: string option price: string option cleanPrice: string option accruedInterest: string option date: string option maturityDate: string option } type StockQuoteApiResponse = { code: string name: string option price: string option currency: string } type StockDailyObservationApiResponse = { date: string close: string volume: string option amount: string option } type StockDailyApiResponse = { code: string observations: StockDailyObservationApiResponse list } module App = let addOptionFriendlyJson (services: IServiceCollection) = let settings = Newtonsoft.Json.JsonSerializerSettings( ContractResolver = Newtonsoft.Json.Serialization.CamelCasePropertyNamesContractResolver() ) settings.Converters.Add(OptionJsonConverter()) services.AddSingleton(NewtonsoftJson.Serializer settings) 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 decimalText (value: decimal) = value.ToString("0.00000000", invariant) let private dateText (value: DateOnly) = value.ToString("yyyy-MM-dd", invariant) let private timestampText (value: DateTimeOffset) = value.ToString("O", 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 reservedCash = cashText fund.ReservedCash status = fund.Status } let private orderResponse (order: SubscriptionOrderRecord) : SubscriptionOrderDetailResponse = let quoteEvidence = order.ConfirmedQuote |> Option.map (fun quote -> { navDate = dateText quote.NavDate nav = decimalText quote.Nav source = quote.Source sourceRevision = quote.Revision sourceCollectedAt = timestampText quote.CollectedAt publishedAt = quote.PublishedAt |> Option.map timestampText sourcePayloadHash = quote.PayloadHash firstSeenAt = timestampText quote.FirstSeenAt }) { id = order.Id fundId = order.FundId fundCode = order.FundCode amount = cashText order.Amount feeAmount = cashText order.FeeAmount reservedTotal = cashText order.ReservedTotal status = order.Status submittedAt = timestampText order.SubmittedAt tradeDate = dateText order.TradeDate confirmIdempotencyKey = order.ConfirmIdempotencyKey pendingReason = order.PendingReason confirmedAt = order.ConfirmedAt |> Option.map timestampText confirmedNav = order.ConfirmedQuote |> Option.map (fun quote -> decimalText quote.Nav) confirmedNavDate = order.ConfirmedQuote |> Option.map (fun quote -> dateText quote.NavDate) confirmedUnits = order.ConfirmedUnits |> Option.map decimalText confirmedInvestedCash = order.ConfirmedInvestedCash |> Option.map cashText confirmedResidualCash = order.ConfirmedResidualCash |> Option.map cashText quote = quoteEvidence 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 stockTradeResponse (trade: StockTradeRecord) : StockTradeResponse = { id = trade.Id fundId = trade.FundId instrumentCode = trade.InstrumentCode stockName = trade.StockName quantity = decimalText trade.Quantity price = decimalText trade.Price costCash = cashText trade.CostCash executedAt = timestampText trade.ExecutedAt isSynthetic = trade.IsSynthetic } let private stockSellResponse (sell: StockSellRecord) : StockSellResponse = { id = sell.Id fundId = sell.FundId instrumentCode = sell.InstrumentCode stockName = sell.StockName quantity = decimalText sell.Quantity price = decimalText sell.Price feeAmount = cashText sell.FeeAmount proceeds = cashText sell.Proceeds executedAt = timestampText sell.ExecutedAt isSynthetic = sell.IsSynthetic } let private stockPositionResponse (position: StockPositionRecord) : StockPositionResponse = { instrumentCode = position.InstrumentCode stockName = position.StockName quantity = decimalText position.Quantity costCash = cashText position.CostCash lastTradedAt = timestampText position.LastTradedAt } let private bondTradeResponse (trade: BondTradeRecord) : BondTradeResponse = { id = trade.Id fundId = trade.FundId instrumentCode = trade.InstrumentCode bondName = trade.BondName quantity = decimalText trade.Quantity price = decimalText trade.Price costCash = cashText trade.CostCash executedAt = timestampText trade.ExecutedAt isSynthetic = trade.IsSynthetic } let private bondPositionResponse (position: BondPositionRecord) : BondPositionResponse = { instrumentCode = position.InstrumentCode bondName = position.BondName quantity = decimalText position.Quantity costCash = cashText position.CostCash lastTradedAt = timestampText position.LastTradedAt } 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 sipPlanResponse (plan: SipPlanRecord) : SipPlanResponse = { id = plan.Id fundId = plan.FundId instrumentCode = plan.InstrumentCode amount = cashText plan.Amount frequency = SipPolicy.frequencyText plan.Frequency status = plan.Status anchorDate = dateText plan.AnchorDate nextTradeDate = dateText plan.NextTradeDate lastExecutionStatus = plan.LastExecutionStatus lastExecutionDate = plan.LastExecutionDate |> Option.map dateText isSynthetic = plan.IsSynthetic createdAt = timestampText plan.CreatedAt } let private investmentPlanResponse (plan: InvestmentPlanRecord) : InvestmentPlanResponse = { id = plan.Id fundId = plan.FundId instrumentCode = plan.InstrumentCode amount = cashText plan.Amount frequency = InvestmentPlanPolicy.frequencyText plan.Frequency status = plan.Status anchorDate = dateText plan.AnchorDate nextRunDate = dateText plan.NextRunDate lastRunStatus = plan.LastRunStatus lastRunDate = plan.LastRunDate |> Option.map dateText isSynthetic = plan.IsSynthetic createdAt = timestampText plan.CreatedAt } let private investmentPlanRunOutcomeResponse (outcome: InvestmentPlanRunOutcome) : InvestmentPlanRunOutcomeResponse = { runDate = dateText outcome.RunDate status = outcome.Status orderId = outcome.OrderId |> Option.map (fun id -> id.ToString("D")) pendingReason = outcome.PendingReason } let private investmentPlanRunPlanResponse (result: InvestmentPlanRunPlanResult) : InvestmentPlanRunPlanResponse = { planId = result.PlanId instrumentCode = result.InstrumentCode amount = cashText result.Amount frequency = InvestmentPlanPolicy.frequencyText result.Frequency runs = result.Runs |> List.map investmentPlanRunOutcomeResponse nextRunDate = dateText result.NextRunDate } let private investmentPlanRunResponse (result: InvestmentPlanRunResult) : InvestmentPlanRunResponse = { fundId = result.FundId processingDate = dateText result.ProcessingDate plans = result.Plans |> List.map investmentPlanRunPlanResponse } let private rebalancePlanResponse (plan: RebalancePlanRecord) : RebalancePlanResponse = { id = plan.Id fundId = plan.FundId targets = plan.Targets |> List.map (fun target -> {| instrumentCode = target.InstrumentCode targetPercent = cashText target.TargetPercent |}) status = plan.Status createdAt = timestampText plan.CreatedAt } let private rebalanceExecutionResponse (result: RebalanceExecutionResult) : RebalanceExecutionResponse = { planId = result.PlanId runDate = dateText result.RunDate outcomes = result.Outcomes |> List.map (fun outcome -> {| instrumentCode = outcome.InstrumentCode action = outcome.Action amount = outcome.Amount status = outcome.Status orderId = outcome.OrderId |> Option.map (fun id -> id.ToString("D")) pendingReason = outcome.PendingReason |}) } let private rebalanceExecutionRecordResponse (record: RebalanceExecutionRecord) : RebalanceExecutionRecordResponse = { planId = record.PlanId runDate = dateText record.RunDate instrumentCode = record.InstrumentCode action = record.Action amount = cashText record.Amount status = record.Status orderId = record.OrderId |> Option.map (fun id -> id.ToString("D")) pendingReason = record.PendingReason executedAt = timestampText record.ExecutedAt } let private rebalanceActionText (action: RebalancePolicy.RebalanceAction) = match action with | RebalancePolicy.Buy -> "buy" | RebalancePolicy.Sell -> "sell" | RebalancePolicy.Hold -> "hold" let private rebalanceWeightRowResponse (row: RebalancePolicy.RebalanceWeightRow) : RebalanceWeightRowResponse = { instrumentCode = row.InstrumentCode targetPercent = cashText row.TargetPercent currentValue = cashText row.CurrentValue currentPercent = cashText row.CurrentPercent action = rebalanceActionText row.Action deltaAmount = cashText row.DeltaAmount deltaUnits = row.DeltaUnits |> Option.map decimalText } let private rebalancePreviewResponse (preview: RebalancePreview) : RebalancePreviewResponse = { planId = preview.PlanId runDate = dateText preview.RunDate availableCash = cashText preview.AvailableCash equity = cashText preview.Equity rows = preview.Rows |> List.map rebalanceWeightRowResponse } 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 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 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 parseOrderCommand (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 "fundCode", tryStringProperty root "amount", tryStringProperty root "feeAmount" with | Some fundCode, Some amountText, Some feeAmountText -> match tryDecimal "amount" amountText, tryDecimal "feeAmount" feeAmountText with | Ok amount, Ok feeAmount -> Ok { FundCode = fundCode Amount = amount FeeAmount = feeAmount } | Error message, _ | _, Error message -> Error message | _ -> Error "fundCode, amount and feeAmount are required" 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 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 parseStockTradeCommand (body: string) : Result = 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" with | None -> Error "instrumentCode is required" | Some code -> if code.Trim().Length <> 6 || not (code.Trim() |> Seq.forall Char.IsDigit) then Error "instrumentCode must contain exactly six digits" else match tryStringProperty root "quantity" with | None -> Error "quantity is required" | Some quantityText -> match tryDecimal "quantity" quantityText with | Error message -> Error message | Ok quantity -> Ok { InstrumentCode = code.Trim() StockName = tryStringProperty root "stockName" Quantity = quantity Price = 0m } with | :? JsonException -> Error "request body must be valid JSON" let private parseStockSellCommand (body: string) : Result = 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" with | None -> Error "instrumentCode is required" | Some code -> if code.Trim().Length <> 6 || not (code.Trim() |> Seq.forall Char.IsDigit) then Error "instrumentCode must contain exactly six digits" else match tryStringProperty root "quantity" with | None -> Error "quantity is required" | Some quantityText -> match tryDecimal "quantity" quantityText with | Error message -> Error message | Ok quantity -> match tryStringProperty root "feeAmount" with | None -> Ok { InstrumentCode = code.Trim() StockName = tryStringProperty root "stockName" Quantity = quantity Price = 0m FeeAmount = 0m } | Some feeText -> match tryDecimal "feeAmount" feeText with | Error message -> Error message | Ok fee -> Ok { InstrumentCode = code.Trim() StockName = tryStringProperty root "stockName" Quantity = quantity Price = 0m FeeAmount = fee } with | :? JsonException -> Error "request body must be valid JSON" let private parseBondTradeCommand (body: string) : Result = 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" with | None -> Error "instrumentCode is required" | Some code -> if code.Trim().Length <> 6 || not (code.Trim() |> Seq.forall Char.IsDigit) then Error "instrumentCode must contain exactly six digits" else match tryStringProperty root "quantity" with | None -> Error "quantity is required" | Some quantityText -> match tryDecimal "quantity" quantityText with | Error message -> Error message | Ok quantity -> Ok { InstrumentCode = code.Trim() BondName = tryStringProperty root "bondName" Quantity = quantity Price = 0m } with | :? JsonException -> Error "request body must be valid JSON" let private parseSipPlanCommand (body: string) : Result = 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 "amount", tryStringProperty root "frequency" with | Some code, Some amountText, Some frequencyText -> match tryDecimal "amount" amountText, SipPolicy.parseFrequency frequencyText with | Ok amount, Some frequency -> Ok { InstrumentCode = code Amount = amount Frequency = frequency } | Error message, _ -> Error message | _, None -> Error "frequency must be one of weekly, biweekly or monthly" | _ -> Error "instrumentCode, amount and frequency are required" with | :? JsonException -> Error "request body must be valid JSON" let private parseInvestmentPlanCommand (body: string) : Result = 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 "amount", tryStringProperty root "frequency" with | Some code, Some amountText, Some frequencyText -> match tryDecimal "amount" amountText, InvestmentPlanPolicy.parseFrequency frequencyText with | Ok amount, Some frequency -> Ok { InstrumentCode = code Amount = amount Frequency = frequency } | Error message, _ -> Error message | _, None -> Error "frequency must be one of daily, weekly or monthly" | _ -> Error "instrumentCode, amount and frequency are required" with | :? JsonException -> Error "request body must be valid JSON" let private parseRebalancePlanCommand (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 let mutable mutableTargets = Unchecked.defaultof if not (root.TryGetProperty("targets", &mutableTargets)) then Error "targets is required" else let targetsElement = mutableTargets if targetsElement.ValueKind <> JsonValueKind.Array then Error "targets must be an array" else let mutable failure = None let rows = ResizeArray() for item in targetsElement.EnumerateArray() do if failure.IsNone then match tryStringProperty item "instrumentCode", tryStringProperty item "targetPercent" with | Some code, Some percentText -> match tryDecimal "targetPercent" percentText with | Ok percent -> let targetRow: RebalancePolicy.TargetAllocation = { RebalancePolicy.TargetAllocation.InstrumentCode = code TargetPercent = percent } rows.Add(targetRow) | Error message -> failure <- Some message | _ -> failure <- Some "each target needs instrumentCode and targetPercent" match failure with | Some message -> Error message | None -> Ok { Targets = rows |> Seq.toList } with | :? JsonException -> Error "request body must be valid JSON" let private parseDividendCommand (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 "navDate", tryStringProperty root "dps", tryStringProperty root "mode" with | Some code, Some navDateText, Some dpsText, Some modeText -> match tryDecimal "dps" dpsText, DividendPolicy.parseMode modeText, DateOnly.TryParseExact(navDateText, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | Ok dps, Some mode, (true, navDate) -> Ok { InstrumentCode = code NavDate = navDate Dps = dps Mode = mode } | Error message, _, _ -> Error message | _, None, _ -> Error "mode must be cash or reinvest" | _, _, (false, _) -> Error "navDate must be yyyy-MM-dd" | _ -> Error "instrumentCode, navDate, dps and mode are required" with | :? JsonException -> Error "request body must be valid JSON" let private dividendResponse (record: DividendRecord) : DividendResponse = { id = record.Id fundId = record.FundId instrumentCode = record.InstrumentCode navDate = dateText record.NavDate dps = decimalText record.Dps mode = DividendPolicy.modeText record.Mode sourceKey = DividendPolicy.schemeKey record.FundId record.InstrumentCode record.NavDate record.Mode status = record.Status grossCash = record.GrossCash |> Option.map cashText creditedUnits = record.CreditedUnits |> Option.map decimalText creditedInvested = record.CreditedInvested |> Option.map cashText orderId = record.OrderId |> Option.map (fun id -> id.ToString("D")) pendingReason = record.PendingReason isSynthetic = record.IsSynthetic createdAt = timestampText record.CreatedAt } let private invokeHandler handler next ctx = handler next ctx let private createDividend (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_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 parseDividendCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_REQUEST" message) next ctx | Ok command -> try match repository.RegisterDividend(idempotencyKey, fundId, command) with | DividendWriteResult.DividendCredited record | DividendWriteResult.DividendReplayed record -> return! invokeHandler (json (dividendResponse record)) next ctx | DividendWriteResult.DividendPendingReinvest record -> return! invokeHandler (json (dividendResponse record)) next ctx | DividendWriteResult.DividendIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "dividend scheme already registered with a different amount") next ctx | DividendWriteResult.DividendInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_DIVIDEND_REQUEST" message) next ctx | DividendWriteResult.DividendFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | DividendWriteResult.DividendInstrumentNotFound -> return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx | DividendWriteResult.DividendNoHoldings -> return! invokeHandler (errorResponse 409 "NO_HOLDINGS" "the instrument has no confirmed holdings to receive the dividend") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "dividend persistence failed") next ctx } let private getDividends (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 records = repository.GetDividendRecords fundId json (records |> List.map dividendResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "dividend persistence failed" next ctx let private returnsPointResponse (point: FundReturnsPoint) : FundReturnsPointResponse = { date = dateText point.Date pending = point.Pending totalAssets = point.TotalAssets |> Option.map cashText unitNav = point.UnitNav |> Option.map unitNavText cash = cashText point.Cash reservedCash = cashText point.ReservedCash holdingsValue = point.HoldingsValue |> Option.map cashText cumulativeReturn = point.CumulativeReturn |> Option.map cashText netExternalFlow = cashText point.NetExternalFlow } let private getFundReturns (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.GetFundReturns fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some returns -> json ({ fundId = returns.FundId pending = returns.Pending dataUpdatedAt = returns.DataUpdatedAt |> Option.map timestampText points = returns.Points |> List.map returnsPointResponse } : FundReturnsResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "returns persistence failed" next ctx let private unauthorized : HttpHandler = setStatusCode 401 >=> setHttpHeader "WWW-Authenticate" "Bearer" >=> text "Unauthorized" let private requireBearer (next: HttpFunc) (ctx: HttpContext) = let expectedToken = Environment.GetEnvironmentVariable("FUND_LAB_AUTH_TOKEN") |> Option.ofObj |> Option.defaultValue "" let authorizationHeader = ctx.Request.Headers.Authorization.ToString() match Authentication.authorize expectedToken authorizationHeader with | AuthDecision.Authorized -> next ctx | AuthDecision.Unauthorized -> unauthorized next ctx let private health : HttpHandler = json ({ service = "fund-lab-api" status = "ok" } : HealthResponse) let private emptyPortfolio : HttpHandler = 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 private createOrder (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_FUND_ID" "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 parseOrderCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_ORDER_REQUEST" message) next ctx | Ok command -> try match repository.CreateSubscriptionOrder(idempotencyKey, fundId, command) with | SubscriptionOrderWriteResult.OrderCreated order -> return! invokeHandler (setStatusCode 201 >=> json (orderResponse order)) next ctx | SubscriptionOrderWriteResult.OrderReplayed order -> return! invokeHandler (json (orderResponse order)) next ctx | SubscriptionOrderWriteResult.OrderIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | SubscriptionOrderWriteResult.OrderInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_ORDER_REQUEST" message) next ctx | SubscriptionOrderWriteResult.OrderFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | SubscriptionOrderWriteResult.OrderInstrumentNotFound -> return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "fund code was not found in the instrument catalog") next ctx | SubscriptionOrderWriteResult.OrderInsufficientFunds -> return! invokeHandler (errorResponse 409 "INSUFFICIENT_FUNDS" "available cash is not enough to reserve the amount plus fee") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "order persistence failed") next ctx } let private getOrders (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.GetSubscriptionOrders fundId json (orders |> List.map orderResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "order persistence failed" next ctx let private confirmOrder (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.ConfirmSubscriptionOrder(idempotencyKey, fundId, orderId) with | OrderConfirmed order | ConfirmReplayed order | ConfirmPendingNav order -> json (orderResponse order) next ctx | ConfirmIdempotencyConflict -> errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request" next ctx | ConfirmAlreadyConfirmed -> errorResponse 409 "ORDER_ALREADY_CONFIRMED" "order was already confirmed with a different idempotency key" next ctx | ConfirmOrderNotFound -> errorResponse 404 "ORDER_NOT_FOUND" "order was not found" next ctx | ConfirmInvalidStatus -> errorResponse 409 "ORDER_INVALID_STATUS" "order is not in a confirmable status" next ctx | ConfirmInvalid message -> errorResponse 400 "INVALID_CONFIRM_REQUEST" message next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "order confirmation failed" next ctx let private getPositions (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 fund -> let positions: FundPositionResponse list = repository.GetFundPositions fundId |> List.map (fun (position: FundPositionRecord) -> { 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 valuationNavDate = position.ValuationNavDate |> Option.map dateText valuationCollectedAt = position.ValuationCollectedAt |> Option.map timestampText }) json ({ fundId = fund.Id availableCash = cashText fund.AvailableCash reservedCash = cashText fund.ReservedCash positions = positions } : FundPositionsResponse) next ctx 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 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 createSipPlan (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_SIP_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 parseSipPlanCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_SIP_REQUEST" message) next ctx | Ok command -> try match repository.CreateSipPlan(idempotencyKey, fundId, command) with | SipPlanWriteResult.SipPlanCreated plan -> return! invokeHandler (setStatusCode 201 >=> json (sipPlanResponse plan)) next ctx | SipPlanWriteResult.SipPlanReplayed plan -> return! invokeHandler (json (sipPlanResponse plan)) next ctx | SipPlanWriteResult.SipPlanIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | SipPlanWriteResult.SipPlanInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_SIP_REQUEST" message) next ctx | SipPlanWriteResult.SipPlanFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | SipPlanWriteResult.SipPlanInstrumentNotFound -> return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "sip plan persistence failed") next ctx } let private getSipPlans (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 plans = repository.GetSipPlans fundId json (plans |> List.map sipPlanResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "sip plan persistence failed" next ctx let private setSipPlanStatus (repository: FundRepository) (targetStatus: string) (fundIdText: string) (planIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText, Guid.TryParse planIdText with | (false, _), _ | _, (false, _) -> errorResponse 400 "INVALID_SIP_REQUEST" "fund id and plan id must be UUIDs" next ctx | (true, fundId), (true, planId) -> try match repository.GetFund fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some _ -> match repository.SetSipPlanStatus(fundId, planId, targetStatus) with | SipPlanStatusResult.SipPlanStatusChanged plan -> json (sipPlanResponse plan) next ctx | SipPlanStatusResult.SipPlanStatusNotFound -> errorResponse 404 "PLAN_NOT_FOUND" "sip plan does not belong to this fund" next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "sip plan status update failed" next ctx let private createInvestmentPlan (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_INVESTMENT_PLAN_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 parseInvestmentPlanCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_INVESTMENT_PLAN_REQUEST" message) next ctx | Ok command -> try match repository.CreateInvestmentPlan(idempotencyKey, fundId, command) with | InvestmentPlanWriteResult.InvestmentPlanCreated plan -> return! invokeHandler (setStatusCode 201 >=> json (investmentPlanResponse plan)) next ctx | InvestmentPlanWriteResult.InvestmentPlanReplayed plan -> return! invokeHandler (json (investmentPlanResponse plan)) next ctx | InvestmentPlanWriteResult.InvestmentPlanIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | InvestmentPlanWriteResult.InvestmentPlanInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_INVESTMENT_PLAN_REQUEST" message) next ctx | InvestmentPlanWriteResult.InvestmentPlanFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | InvestmentPlanWriteResult.InvestmentPlanInstrumentNotFound -> return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "investment plan persistence failed") next ctx } let private getInvestmentPlans (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 plans = repository.GetInvestmentPlans fundId json (plans |> List.map investmentPlanResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "investment plan persistence failed" next ctx let private parseInvestmentPlanRunCommand (body: string) = try if String.IsNullOrWhiteSpace body then Ok None else 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 "processingDate" with | None -> Ok None | Some text -> match DateOnly.TryParseExact(text, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | true, date -> Ok(Some date) | _ -> Error "processingDate must be yyyy-MM-dd" with | :? JsonException -> Error "request body must be valid JSON" let private runInvestmentPlans (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_INVESTMENT_PLAN_REQUEST" "fund id must be a UUID") next ctx | true, fundId -> use reader = new StreamReader(ctx.Request.Body) let! body = reader.ReadToEndAsync() match parseInvestmentPlanRunCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_INVESTMENT_PLAN_REQUEST" message) next ctx | Ok processingDateText -> let processingDate = processingDateText |> Option.defaultWith (fun () -> ConfirmationPolicy.tradeDateFor DateTimeOffset.UtcNow) try match repository.GetFund fundId with | None -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | Some _ -> let result = repository.RunInvestmentPlans(fundId, processingDate) return! invokeHandler (json (investmentPlanRunResponse result)) next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "investment plan run failed") next ctx } let private parseSipAdvanceCommand (body: string) = try if String.IsNullOrWhiteSpace body then Ok(None, 24) else use document = JsonDocument.Parse(body) let root = document.RootElement if root.ValueKind <> JsonValueKind.Object then Error "request body must be a JSON object" else let endDate = match tryStringProperty root "endDate" with | None -> None | Some text -> match DateOnly.TryParseExact(text, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | true, date -> Some date | _ -> failwith "endDate must be yyyy-MM-dd" let limit = match tryStringProperty root "limit" with | None -> 24 | Some text -> match Int32.TryParse(text, CultureInfo.InvariantCulture) with | true, value when value > 0 -> value | _ -> failwith "limit must be a positive integer" Ok(endDate, limit) with | :? JsonException -> Error "request body must be valid JSON" let private sipPlanAdvanceResponse (result: SipPlanAdvanceResult) = {| planId = result.PlanId instrumentCode = result.InstrumentCode amount = cashText result.Amount frequency = SipPolicy.frequencyText result.Frequency nextTradeDate = dateText result.NextTradeDate executions = result.Executions |> List.map (fun outcome -> {| tradeDate = dateText outcome.TradeDate status = outcome.Status orderId = outcome.OrderId |> Option.map (fun id -> id.ToString("D")) pendingReason = outcome.PendingReason |}) |} let private advanceSipPlans (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_SIP_REQUEST" "fund id must be a UUID") next ctx | true, fundId -> use reader = new StreamReader(ctx.Request.Body) let! body = reader.ReadToEndAsync() match parseSipAdvanceCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_SIP_REQUEST" message) next ctx | Ok(endDateText, limit) -> let endDate = endDateText |> Option.defaultWith (fun () -> ConfirmationPolicy.tradeDateFor DateTimeOffset.UtcNow) try match repository.GetFund fundId with | None -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | Some _ -> let advanced = repository.AdvanceSipPlans(fundId, endDate, limit) return! json {| fundId = fundId endDate = dateText endDate plans = advanced.Plans |> List.map sipPlanAdvanceResponse |} next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "sip advance failed") next ctx } let private createRebalancePlan (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_REBALANCE_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 parseRebalancePlanCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_REBALANCE_REQUEST" message) next ctx | Ok command -> try match repository.CreateRebalancePlan(idempotencyKey, fundId, command) with | RebalanceWriteResult.RebalancePlanCreated plan -> return! invokeHandler (setStatusCode 201 >=> json (rebalancePlanResponse plan)) next ctx | RebalanceWriteResult.RebalancePlanReplayed plan -> return! invokeHandler (json (rebalancePlanResponse plan)) next ctx | RebalanceWriteResult.RebalanceIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | RebalanceWriteResult.RebalanceInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_REBALANCE_REQUEST" message) next ctx | RebalanceWriteResult.RebalanceFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | RebalanceWriteResult.RebalanceInstrumentNotFound -> return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "rebalance plan persistence failed") next ctx } let private getRebalancePlans (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 plans = repository.GetRebalancePlans fundId json (plans |> List.map rebalancePlanResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "rebalance plan persistence failed" next ctx let private archiveRebalancePlan (repository: FundRepository) (fundIdText: string) (planIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText, Guid.TryParse planIdText with | (false, _), _ | _, (false, _) -> errorResponse 400 "INVALID_REBALANCE_REQUEST" "fund id and plan id must be UUIDs" next ctx | (true, fundId), (true, planId) -> try match repository.GetFund fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some _ -> match repository.ArchiveRebalancePlan(fundId, planId) with | RebalanceArchiveResult.RebalancePlanArchived plan -> json (rebalancePlanResponse plan) next ctx | RebalanceArchiveResult.RebalanceArchiveNotFound -> errorResponse 404 "PLAN_NOT_FOUND" "rebalance plan does not belong to this fund" next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "rebalance plan archive failed" next ctx let private executeRebalancePlan (repository: FundRepository) (fundIdText: string) (planIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText, Guid.TryParse planIdText with | (false, _), _ | _, (false, _) -> errorResponse 400 "INVALID_REBALANCE_REQUEST" "fund id and plan id must be UUIDs" next ctx | (true, fundId), (true, planId) -> try match repository.GetFund fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some _ -> match repository.ExecuteRebalancePlan planId with | Error message -> if message.Contains("is archived") then errorResponse 409 "PLAN_ARCHIVED" "rebalance plan is archived" next ctx else errorResponse (if message.Contains("was not found") then 404 else 400) "INVALID_REBALANCE_REQUEST" message next ctx | Ok result -> if result.PlanId <> Guid.Empty && repository.GetRebalancePlans fundId |> List.exists (fun plan -> plan.Id = result.PlanId) |> not then errorResponse 404 "PLAN_NOT_FOUND" "rebalance plan does not belong to this fund" next ctx else json (rebalanceExecutionResponse result) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "rebalance execution failed" next ctx let private getRebalanceExecutions (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 records = repository.GetRebalanceExecutions fundId json (records |> List.map rebalanceExecutionRecordResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "rebalance execution persistence failed" next ctx let private previewRebalancePlan (repository: FundRepository) (fundIdText: string) (planIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText, Guid.TryParse planIdText with | (false, _), _ | _, (false, _) -> errorResponse 400 "INVALID_REBALANCE_REQUEST" "fund id and plan id must be UUIDs" next ctx | (true, fundId), (true, planId) -> try match repository.GetFund fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some _ -> if repository.GetRebalancePlans fundId |> List.exists (fun plan -> plan.Id = planId) |> not then errorResponse 404 "PLAN_NOT_FOUND" "rebalance plan does not belong to this fund" next ctx else match repository.PreviewRebalancePlan planId with | Error message -> if message.Contains("is archived") then errorResponse 409 "PLAN_ARCHIVED" "rebalance plan is archived" next ctx else errorResponse 400 "INVALID_REBALANCE_REQUEST" message next ctx | Ok preview -> json (rebalancePreviewResponse preview) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "rebalance preview failed" next ctx let private marketDataError (failure: MarketDataFailure) : HttpHandler = let status, error, message = match failure with | InvalidMarketDataRequest message -> 400, "INVALID_MARKET_DATA_REQUEST", message | MarketDataCollectorUnavailable message -> 503, "MARKET_DATA_UNAVAILABLE", message | InvalidMarketDataPayload message -> 502, "INVALID_MARKET_DATA_PAYLOAD", message | MarketDataPersistenceFailure _ -> 500, "PERSISTENCE_ERROR", "market data persistence failed" errorResponse status error message let private marketDataErrorText (failure: MarketDataFailure) = match failure with | InvalidMarketDataRequest message -> message | MarketDataCollectorUnavailable message -> message | InvalidMarketDataPayload message -> message | MarketDataPersistenceFailure message -> message let private marketDataInstrumentResponse (instrument: MarketDataInstrument) = { code = instrument.Code name = instrument.Name fundType = instrument.FundType } let private marketDataSearchResponse (payload: MarketDataSearchPayload) = { source = payload.Source sourceRevision = payload.SourceRevision collectedAt = timestampText payload.CollectedAt instruments = payload.Instruments |> List.map marketDataInstrumentResponse } let private marketDataObservationResponse (observation: MarketDataNavRecord) = { code = observation.Code navDate = dateText observation.NavDate publishedAt = observation.PublishedAt |> Option.map timestampText nav = decimalText observation.Nav accumulatedNav = observation.AccumulatedNav |> Option.map decimalText dailyReturn = observation.DailyReturn |> Option.map decimalText source = observation.Source sourceRevision = observation.SourceRevision sourceCollectedAt = timestampText observation.SourceCollectedAt sourcePayloadHash = observation.SourcePayloadHash firstSeenAt = timestampText observation.FirstSeenAt lastSeenAt = timestampText observation.LastSeenAt } let private marketDataNavResponse code (observations: MarketDataNavRecord list) : MarketDataNavApiResponse = { code = code observations = observations |> List.map marketDataObservationResponse } let private searchInstruments (marketData: IMarketDataService) : HttpHandler = fun next ctx -> match marketData.Search(ctx.Request.Query["q"].ToString(), ctx.RequestAborted) with | Ok payload -> json (marketDataSearchResponse payload) next ctx | Error failure -> marketDataError failure next ctx let private refreshNav (marketData: IMarketDataService) (code: string) : HttpHandler = fun next ctx -> match marketData.RefreshNav(code, ctx.RequestAborted) with | Ok observations -> json (marketDataNavResponse code observations) next ctx | Error failure -> marketDataError failure next ctx let private queryDate (name: string) (ctx: HttpContext) = let value = ctx.Request.Query[name].ToString() if String.IsNullOrWhiteSpace value then Ok None else let mutable date = DateOnly.MinValue if DateOnly.TryParseExact(value, "yyyy-MM-dd", invariant, DateTimeStyles.None, &date) then Ok(Some date) else Error(sprintf "%s must be an ISO date" name) let private getNav (marketData: IMarketDataService) (code: string) : HttpHandler = fun next ctx -> match queryDate "from" ctx, queryDate "to" ctx with | Ok fromDate, Ok toDate -> match marketData.GetNav(code, fromDate, toDate) with | Ok observations -> json (marketDataNavResponse code observations) next ctx | Error failure -> marketDataError failure next ctx | Error message, _ | _, Error message -> marketDataError (InvalidMarketDataRequest message) next ctx let private marketDataRoutes (marketData: IMarketDataService) = [ GET >=> route "/instruments/search" >=> searchInstruments marketData POST >=> routef "/instruments/%s/nav/refresh" (refreshNav marketData) GET >=> routef "/instruments/%s/nav" (getNav marketData) ] let private getMarketNavDates (probe: INavDateProbe) : HttpHandler = fun next ctx -> let code = ctx.Request.Query["code"].ToString() match probe.RecentNavDates(code, 5, ctx.RequestAborted) with | Ok dates -> json ({ code = code.Trim(); dates = dates |> List.map dateText } : MarketNavDatesApiResponse) next ctx | Error failure -> marketDataError failure next ctx let private marketNavSeriesPointResponse (point: NavSeriesPoint) : MarketNavSeriesPointApiResponse = { navDate = dateText point.NavDate nav = decimalText point.Nav accumulatedNav = point.AccumulatedNav |> Option.map decimalText } let private getMarketNavSeries (probe: INavSeriesProbe) : HttpHandler = fun next ctx -> let code = ctx.Request.Query["code"].ToString() let limitText = ctx.Request.Query["limit"].ToString() let limit = if String.IsNullOrWhiteSpace limitText then Ok 30 else match Int32.TryParse(limitText, NumberStyles.Integer, invariant) with | true, value when value >= 1 && value <= 250 -> Ok value | _ -> Error "limit must be an integer between 1 and 250" match limit with | Error message -> marketDataError (InvalidMarketDataRequest message) next ctx | Ok value -> match probe.RecentNavSeries(code, value, ctx.RequestAborted) with | Ok points -> json ({ code = code.Trim() points = points |> List.map marketNavSeriesPointResponse } : MarketNavSeriesApiResponse) next ctx | Error failure -> marketDataError failure next ctx let private getBondQuote (probe: IBondQuoteProbe) : HttpHandler = fun next ctx -> let code = ctx.Request.Query["code"].ToString() match probe.GetQuote(code, ctx.RequestAborted) with | Ok quote -> json ({ code = quote.Code sourceRevision = quote.SourceRevision name = quote.Name price = quote.Price |> Option.map decimalText cleanPrice = quote.CleanPrice |> Option.map decimalText accruedInterest = quote.AccruedInterest |> Option.map decimalText date = quote.Date |> Option.map dateText maturityDate = quote.MaturityDate |> Option.map dateText } : BondQuoteApiResponse) next ctx | Error failure -> marketDataError failure next ctx let private getStockQuote (probe: IStockQuoteProbe) : HttpHandler = fun next ctx -> let code = ctx.Request.Query["code"].ToString() match probe.GetQuote(code, ctx.RequestAborted) with | Ok quote -> json ({ code = quote.Code name = quote.Name price = quote.Price |> Option.map decimalText currency = quote.Currency } : StockQuoteApiResponse) next ctx | Error failure -> marketDataError failure next ctx let private stockDailyObservationResponse (observation: StockDailyObservation) : StockDailyObservationApiResponse = { date = dateText observation.BarDate close = decimalText observation.Close volume = observation.Volume |> Option.map decimalText amount = observation.Amount |> Option.map decimalText } let private getStockDaily (probe: IStockDailyProbe) : HttpHandler = fun next ctx -> let code = ctx.Request.Query["code"].ToString() let daysText = ctx.Request.Query["days"].ToString() let days = if String.IsNullOrWhiteSpace daysText then Ok 5 else match Int32.TryParse(daysText, NumberStyles.Integer, invariant) with | true, value when value >= 1 && value <= 30 -> Ok value | _ -> Error "days must be an integer between 1 and 30" match days with | Error message -> marketDataError (InvalidMarketDataRequest message) next ctx | Ok value -> match probe.RecentDaily(code, value, ctx.RequestAborted) with | Ok observations -> json ({ code = code.Trim() observations = observations |> List.map stockDailyObservationResponse } : StockDailyApiResponse) next ctx | Error failure -> marketDataError failure next ctx let private createStockTrade (repository: FundRepository) (probes: MarketProbes option) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_TRADE_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 parseStockTradeCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_TRADE_REQUEST" message) next ctx | Ok command -> match probes with | None -> return! invokeHandler (marketDataError (MarketDataCollectorUnavailable "stock quote probe is not configured")) next ctx | Some configured -> let quoteResult = configured.StockQuotes.GetQuote(command.InstrumentCode, ctx.RequestAborted) match quoteResult with | Error failure -> return! invokeHandler (marketDataError failure) next ctx | Ok quote -> match quote.Price with | None -> return! invokeHandler (marketDataError (InvalidMarketDataPayload "stock quote did not include a price")) next ctx | Some price -> let resolvedName = match command.StockName with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> match quote.Name with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> None let priced = { command with Price = price; StockName = resolvedName } try match repository.CreateStockTrade(idempotencyKey, fundId, priced) with | StockTradeWriteResult.StockTradeCreated trade -> return! invokeHandler (setStatusCode 201 >=> json (stockTradeResponse trade)) next ctx | StockTradeWriteResult.StockTradeReplayed trade -> return! invokeHandler (json (stockTradeResponse trade)) next ctx | StockTradeWriteResult.StockTradeIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | StockTradeWriteResult.StockTradeInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_TRADE_REQUEST" message) next ctx | StockTradeWriteResult.StockTradeFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "stock trade persistence failed") next ctx } let private getStockPositions (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText with | false, _ -> errorResponse 400 "INVALID_STOCK_TRADE_REQUEST" "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 fund -> let positions = repository.GetStockPositions fundId |> List.map stockPositionResponse json ({ fundId = fund.Id; positions = positions } : StockPositionsResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "stock position persistence failed" next ctx let private completeStockSell (repository: FundRepository) (fundId: Guid) (idempotencyKey: string) (command: StockSellCommand) next ctx = task { try match repository.CreateStockSell(idempotencyKey, fundId, command) with | StockSellWriteResult.StockSellCreated sell -> return! invokeHandler (setStatusCode 201 >=> json (stockSellResponse sell)) next ctx | StockSellWriteResult.StockSellReplayed sell -> return! invokeHandler (json (stockSellResponse sell)) next ctx | StockSellWriteResult.StockSellIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | StockSellWriteResult.StockSellInsufficientHoldings message -> return! invokeHandler (errorResponse 400 "INSUFFICIENT_STOCK_HOLDINGS" message) next ctx | StockSellWriteResult.StockSellInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_SELL_REQUEST" message) next ctx | StockSellWriteResult.StockSellFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "stock sale persistence failed") next ctx } let private createStockSell (repository: FundRepository) (probes: MarketProbes option) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_SELL_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 parseStockSellCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_STOCK_SELL_REQUEST" message) next ctx | Ok command -> let asOfDate = ConfirmationPolicy.eventDateFor DateTimeOffset.UtcNow let snapshotPrice = try repository.GetLatestSnapshots(fundId, "stock", asOfDate) |> Map.tryFind command.InstrumentCode |> Option.map (fun snapshot -> snapshot.Price) with _ -> None let existingName = try repository.GetStockPositions fundId |> List.tryFind (fun position -> position.InstrumentCode = command.InstrumentCode) |> Option.bind (fun position -> position.StockName) with _ -> None let resolveName (candidate: string option) = match candidate with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> existingName match snapshotPrice with | Some price -> return! completeStockSell repository fundId idempotencyKey { command with Price = price; StockName = resolveName command.StockName } next ctx | None -> match probes with | None -> return! invokeHandler (marketDataError (MarketDataCollectorUnavailable "stock quote probe is not configured")) next ctx | Some configured -> match configured.StockQuotes.GetQuote(command.InstrumentCode, ctx.RequestAborted) with | Error failure -> return! invokeHandler (marketDataError failure) next ctx | Ok quote -> match quote.Price with | None -> return! invokeHandler (marketDataError (InvalidMarketDataPayload "stock quote did not include a price")) next ctx | Some price -> return! completeStockSell repository fundId idempotencyKey { command with Price = price; StockName = resolveName quote.Name } next ctx } let private createBondTrade (repository: FundRepository) (probes: MarketProbes option) (fundIdText: string) : HttpHandler = fun next ctx -> task { match Guid.TryParse fundIdText with | false, _ -> return! invokeHandler (errorResponse 400 "INVALID_BOND_TRADE_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 parseBondTradeCommand body with | Error message -> return! invokeHandler (errorResponse 400 "INVALID_BOND_TRADE_REQUEST" message) next ctx | Ok command -> match probes with | None -> return! invokeHandler (marketDataError (MarketDataCollectorUnavailable "bond quote probe is not configured")) next ctx | Some configured -> let quoteResult = configured.BondQuotes.GetQuote(command.InstrumentCode, ctx.RequestAborted) match quoteResult with | Error failure -> return! invokeHandler (marketDataError failure) next ctx | Ok quote -> match quote.Price with | None -> return! invokeHandler (marketDataError (InvalidMarketDataPayload "bond quote did not include a price")) next ctx | Some price -> let resolvedName = match command.BondName with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> match quote.Name with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> None let priced = { command with Price = price; BondName = resolvedName } try match repository.CreateBondTrade(idempotencyKey, fundId, priced) with | BondTradeWriteResult.BondTradeCreated trade -> return! invokeHandler (setStatusCode 201 >=> json (bondTradeResponse trade)) next ctx | BondTradeWriteResult.BondTradeReplayed trade -> return! invokeHandler (json (bondTradeResponse trade)) next ctx | BondTradeWriteResult.BondTradeIdempotencyConflict -> return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx | BondTradeWriteResult.BondTradeInvalid message -> return! invokeHandler (errorResponse 400 "INVALID_BOND_TRADE_REQUEST" message) next ctx | BondTradeWriteResult.BondTradeFundNotFound -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx with _ -> return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "bond trade persistence failed") next ctx } let private getBondPositions (repository: FundRepository) (fundIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText with | false, _ -> errorResponse 400 "INVALID_BOND_TRADE_REQUEST" "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 fund -> let positions = repository.GetBondPositions fundId |> List.map bondPositionResponse json ({ fundId = fund.Id; positions = positions } : BondPositionsResponse) next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "bond position persistence failed" next ctx let private valuationPositionResponse (assetClass: string) (code: string) (fallbackName: string option) (quantity: decimal) (resolvedPrice: (string * decimal) option) = let resolvedName = match fallbackName with | Some name when not (String.IsNullOrWhiteSpace name) -> Some name | _ -> None match resolvedPrice with | Some(source, price) -> { instrumentCode = code name = resolvedName assetClass = assetClass quantity = decimalText quantity price = Some(decimalText price) priceSource = Some source marketValue = Some(cashText (Decimal.Round(quantity * price, 2, MidpointRounding.AwayFromZero))) status = "priced" } | None -> { instrumentCode = code name = resolvedName assetClass = assetClass quantity = decimalText quantity price = None priceSource = None marketValue = None status = "unavailable" } /// Price precedence for a valuation row: a persisted daily snapshot on or /// before the valuation date wins (it is the reproducible daily close), and /// a live quote is only a fallback for instruments not yet refreshed. let private resolveValuationPrice (snapshotPrice: decimal option) (livePrice: unit -> Result) = match snapshotPrice with | Some price -> Some("snapshot", price) | None -> match livePrice () with | Ok(Some price) -> Some("live", price) | _ -> None let private getFundValuation (repository: FundRepository) (probes: MarketProbes option) (fundIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText with | false, _ -> errorResponse 400 "INVALID_VALUATION_REQUEST" "fund id must be a UUID" next ctx | true, fundId -> let asOfDate = let raw = ctx.Request.Query["asOfDate"].ToString() if String.IsNullOrWhiteSpace raw then ConfirmationPolicy.eventDateFor DateTimeOffset.UtcNow else match DateOnly.TryParseExact(raw, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | true, date -> date | _ -> ConfirmationPolicy.eventDateFor DateTimeOffset.UtcNow try match repository.GetFund fundId with | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx | Some fund -> let token = ctx.RequestAborted let stockSnapshots = repository.GetLatestSnapshots(fundId, "stock", asOfDate) let bondSnapshots = repository.GetLatestSnapshots(fundId, "bond", asOfDate) let priceOf (probe: unit -> Result) = if probes.IsNone then Error(MarketDataCollectorUnavailable "market probes are not configured") else probe () let stockRows = repository.GetStockPositions fundId |> List.map (fun position -> let snapshotPrice = stockSnapshots |> Map.tryFind position.InstrumentCode |> Option.map (fun snap -> snap.Price) let resolved = resolveValuationPrice snapshotPrice (fun () -> priceOf (fun () -> probes.Value.StockQuotes.GetQuote(position.InstrumentCode, token) |> Result.map (fun quote -> quote.Price))) valuationPositionResponse "stock" position.InstrumentCode position.StockName position.Quantity resolved) let bondRows = repository.GetBondPositions fundId |> List.map (fun position -> let snapshotPrice = bondSnapshots |> Map.tryFind position.InstrumentCode |> Option.map (fun snap -> snap.Price) let resolved = resolveValuationPrice snapshotPrice (fun () -> priceOf (fun () -> probes.Value.BondQuotes.GetQuote(position.InstrumentCode, token) |> Result.map (fun quote -> quote.Price))) valuationPositionResponse "bond" position.InstrumentCode position.BondName position.Quantity resolved) let positions = stockRows @ bondRows let positionsMarketValue = positions |> List.sumBy (fun position -> match position.marketValue with | Some text -> Decimal.Parse(text, invariant) | None -> 0m) let unavailable = positions |> List.filter (fun position -> position.status = "unavailable") |> List.length let response: FundValuationResponse = { fundId = fund.Id currency = fund.Currency asOfDate = dateText asOfDate cash = cashText fund.AvailableCash positionsMarketValue = cashText positionsMarketValue portfolioValue = cashText (fund.AvailableCash + positionsMarketValue) pricedPositions = positions.Length - unavailable unavailablePositions = unavailable positions = positions } json response next ctx with _ -> errorResponse 500 "PERSISTENCE_ERROR" "fund valuation failed" next ctx let private refreshFundMarketData (repository: FundRepository) (marketData: IMarketDataService option) (probes: MarketProbes option) (fundIdText: string) : HttpHandler = fun next ctx -> match Guid.TryParse fundIdText with | false, _ -> errorResponse 400 "INVALID_MARKET_REFRESH_REQUEST" "fund id must be a UUID" next ctx | true, fundId -> task { match repository.GetFund fundId with | None -> return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx | Some _ -> let asOfDate = let raw = ctx.Request.Query["asOfDate"].ToString() if String.IsNullOrWhiteSpace raw then ConfirmationPolicy.eventDateFor DateTimeOffset.UtcNow else match DateOnly.TryParseExact(raw, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | true, date -> date | _ -> ConfirmationPolicy.eventDateFor DateTimeOffset.UtcNow let token = ctx.RequestAborted let refreshed = ResizeArray() let failures = ResizeArray() let snapshotDateOf (raw: string option) = match raw with | Some text -> match DateOnly.TryParseExact(text, "yyyy-MM-dd", CultureInfo.InvariantCulture, DateTimeStyles.None) with | true, date when date <= asOfDate -> date | _ -> asOfDate | None -> asOfDate // Stocks: persist the latest daily close on or before the refresh date. for position in repository.GetStockPositions fundId do match probes with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "stock" reason = "market probes are not configured" } ) | Some probeSet -> match probeSet.StockDaily.RecentDaily(position.InstrumentCode, 30, token) with | Error failure -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "stock" reason = marketDataErrorText failure } ) | Ok observations -> let latest = observations |> List.filter (fun observation -> observation.BarDate <= asOfDate) |> List.sortByDescending (fun observation -> observation.BarDate) |> List.tryHead match latest with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "stock" reason = "no daily bar on or before the refresh date" } ) | Some bar -> let snapshot : InstrumentSnapshotRecord = { InstrumentCode = position.InstrumentCode AssetClass = "stock" SnapshotDate = bar.BarDate Price = bar.Close Source = "akshare" SourceRevision = "stock-daily" SourceCollectedAt = DateTimeOffset.UtcNow SourcePayloadHash = sprintf "stock-daily:%s:%s" position.InstrumentCode (bar.BarDate.ToString("yyyy-MM-dd")) } repository.UpsertInstrumentSnapshots [ snapshot ] refreshed.Add( { instrumentCode = position.InstrumentCode assetClass = "stock" snapshotDate = dateText bar.BarDate price = decimalText bar.Close } ) // Bonds: persist the latest valuation price. for position in repository.GetBondPositions fundId do match probes with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "bond" reason = "market probes are not configured" } ) | Some probeSet -> match probeSet.BondQuotes.GetQuote(position.InstrumentCode, token) with | Error failure -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "bond" reason = marketDataErrorText failure } ) | Ok quote -> match (quote.Price |> Option.orElse quote.CleanPrice) with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "bond" reason = "bond quote has no valuation price" } ) | Some price -> let snapshotDate = quote.Date |> Option.map (fun date -> date.ToString("yyyy-MM-dd")) |> snapshotDateOf let snapshot : InstrumentSnapshotRecord = { InstrumentCode = position.InstrumentCode AssetClass = "bond" SnapshotDate = snapshotDate Price = price Source = "akshare" SourceRevision = "bond-quote" SourceCollectedAt = DateTimeOffset.UtcNow SourcePayloadHash = sprintf "bond-quote:%s:%s" position.InstrumentCode (snapshotDate.ToString("yyyy-MM-dd")) } repository.UpsertInstrumentSnapshots [ snapshot ] refreshed.Add( { instrumentCode = position.InstrumentCode assetClass = "bond" snapshotDate = dateText snapshotDate price = decimalText price } ) // Held funds: refresh their published NAV history so the // fund-level NAV advances with the same date. for position in repository.GetFundPositions fundId do match marketData with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "fund" reason = "market data service is not configured" } ) | Some service -> match service.RefreshNav(position.InstrumentCode, token) with | Error failure -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "fund" reason = marketDataErrorText failure } ) | Ok observations -> let latest = observations |> List.filter (fun observation -> observation.NavDate <= asOfDate) |> List.sortByDescending (fun observation -> observation.NavDate) |> List.tryHead match latest with | None -> failures.Add( { instrumentCode = position.InstrumentCode assetClass = "fund" reason = "no nav observation on or before the refresh date" } ) | Some observation -> refreshed.Add( { instrumentCode = position.InstrumentCode assetClass = "fund" snapshotDate = dateText observation.NavDate price = decimalText observation.Nav } ) let response: MarketRefreshResponse = { fundId = fundId asOfDate = dateText asOfDate refreshed = refreshed |> Seq.toList failures = failures |> Seq.toList } return! json response next ctx } let private marketProbeRoutes (probes: MarketProbes) = [ GET >=> route "/market/nav-dates" >=> getMarketNavDates probes.NavDates GET >=> route "/market/nav-series" >=> getMarketNavSeries probes.NavSeries GET >=> route "/market/bond-quote" >=> getBondQuote probes.BondQuotes GET >=> route "/market/stock-quote" >=> getStockQuote probes.StockQuotes GET >=> route "/market/stock-daily" >=> getStockDaily probes.StockDaily ] let private createApplicationInternal (repository: FundRepository) (marketData: IMarketDataService option) (probes: MarketProbes option) : HttpHandler = let apiRoutes = [ GET >=> route "/portfolio/summary" >=> emptyPortfolio POST >=> route "/funds" >=> createFund repository 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) POST >=> routef "/funds/%s/capital/deposit" (createCapitalDeposit repository) GET >=> routef "/funds/%s/capital/deposits" (getCapitalDeposits repository) POST >=> routef "/funds/%s/sip/plans" (createSipPlan repository) GET >=> routef "/funds/%s/sip/plans" (getSipPlans repository) POST >=> routef "/funds/%s/sip/advance" (advanceSipPlans repository) POST >=> routef "/funds/%s/sip/plans/%s/pause" (fun (fundId, planId) -> setSipPlanStatus repository "paused" fundId planId) POST >=> routef "/funds/%s/sip/plans/%s/resume" (fun (fundId, planId) -> setSipPlanStatus repository "active" fundId planId) POST >=> routef "/funds/%s/rebalance/plans" (createRebalancePlan repository) GET >=> routef "/funds/%s/rebalance/plans" (getRebalancePlans repository) POST >=> routef "/funds/%s/rebalance/plans/%s/archive" (fun (fundId, planId) -> archiveRebalancePlan repository fundId planId) POST >=> routef "/funds/%s/rebalance/plans/%s/execute" (fun (fundId, planId) -> executeRebalancePlan repository fundId planId) GET >=> routef "/funds/%s/rebalance/plans/%s/preview" (fun (fundId, planId) -> previewRebalancePlan repository fundId planId) GET >=> routef "/funds/%s/rebalance/executions" (getRebalanceExecutions repository) POST >=> routef "/funds/%s/dividends" (createDividend repository) GET >=> routef "/funds/%s/dividends" (getDividends repository) GET >=> routef "/funds/%s/returns" (getFundReturns repository) POST >=> routef "/funds/%s/investment-plans/run" (runInvestmentPlans repository) POST >=> routef "/funds/%s/investment-plans" (createInvestmentPlan repository) GET >=> routef "/funds/%s/investment-plans" (getInvestmentPlans repository) POST >=> routef "/funds/%s/stock-trades" (createStockTrade repository probes) POST >=> routef "/funds/%s/stock-sells" (createStockSell repository probes) GET >=> routef "/funds/%s/stock-positions" (getStockPositions repository) POST >=> routef "/funds/%s/bond-trades" (createBondTrade repository probes) GET >=> routef "/funds/%s/bond-positions" (getBondPositions repository) GET >=> routef "/funds/%s/valuation" (getFundValuation repository probes) POST >=> routef "/funds/%s/market-data/refresh" (fun fundId -> refreshFundMarketData repository marketData probes fundId) GET >=> routef "/funds/%s" (getFund repository) ] @ (marketData |> Option.map marketDataRoutes |> Option.defaultValue []) @ (probes |> Option.map marketProbeRoutes |> Option.defaultValue []) choose [ GET >=> route "/health" >=> health subRoute "/api" ( requireBearer >=> choose apiRoutes ) setStatusCode 404 >=> text "Not Found" ] let createApplicationWithMarketData (repository: FundRepository) (marketData: IMarketDataService) : HttpHandler = createApplicationInternal repository (Some marketData) None let createApplicationWithProbes (repository: FundRepository) (probes: MarketProbes) : HttpHandler = createApplicationInternal repository None (Some probes) let createApplicationWithMarketDataAndProbes (repository: FundRepository) (marketData: IMarketDataService) (probes: MarketProbes) : HttpHandler = createApplicationInternal repository (Some marketData) (Some probes) let createApplication (repository: FundRepository) : HttpHandler = createApplicationInternal repository None None