namespace FundLab.Api open System open System.Globalization open System.IO open System.Text.Json 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 CapitalDepositResponse = { id: Guid fundId: Guid amount: string note: string option isSynthetic: bool createdAt: string } 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 } 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 capitalDepositResponse (deposit: CapitalDepositRecord) : CapitalDepositResponse = { id = deposit.Id fundId = deposit.FundId amount = cashText deposit.Amount note = deposit.Note isSynthetic = deposit.IsSynthetic createdAt = timestampText deposit.CreatedAt } let private errorResponse status error message : HttpHandler = setStatusCode status >=> json ({ 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 invokeHandler handler next ctx = handler 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 = repository.GetFundPositions fundId |> List.map (fun position -> { 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 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 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 = { 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 createApplicationInternal (repository: FundRepository) (marketData: IMarketDataService 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) GET >=> routef "/funds/%s" (getFund repository) ] @ (marketData |> Option.map marketDataRoutes |> 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) let createApplication (repository: FundRepository) : HttpHandler = createApplicationInternal repository None