path: root/src/FundLab.Api/App.fs

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<option<_>>

    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 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 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 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<Giraffe.Json.ISerializer>(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 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 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 errorResponse status error message : HttpHandler =
        setStatusCode status
        >=> json ({
            error = error
            message = message
        } : ApiErrorResponse)

    let private tryStringProperty (root: JsonElement) (name: string) =
        let mutable property = Unchecked.defaultof<JsonElement>

        if root.TryGetProperty(name, &property) && property.ValueKind = JsonValueKind.String then
            property.GetString() |> Option.ofObj
        else
            None

    let private tryBoolProperty (root: JsonElement) (name: string) =
        let mutable property = Unchecked.defaultof<JsonElement>

        if root.TryGetProperty(name, &property) then
            match property.ValueKind with
            | JsonValueKind.True -> Some true
            | JsonValueKind.False -> Some false
            | _ -> None
        else
            None

    let private tryDecimal (label: string) (text: string) =
        if String.IsNullOrWhiteSpace text then
            Error(sprintf "%s must be a decimal string" label)
        else
            match Decimal.TryParse(text, NumberStyles.AllowLeadingSign ||| NumberStyles.AllowDecimalPoint, invariant) with
            | true, value -> Ok value
            | false, _ -> Error(sprintf "%s must be a decimal string" label)

    let private parseFundCommand (body: string) =
        try
            use document = JsonDocument.Parse(body)
            let root = document.RootElement

            if root.ValueKind <> JsonValueKind.Object then
                Error "request body must be a JSON object"
            else
                match tryStringProperty root "name", tryStringProperty root "initialCash", tryStringProperty root "initialUnitNav", tryBoolProperty root "isSynthetic" with
                | Some name, Some initialCashText, Some initialUnitNavText, Some isSynthetic ->
                    match tryDecimal "initialCash" initialCashText, tryDecimal "initialUnitNav" initialUnitNavText with
                    | Ok initialCash, Ok initialUnitNav ->
                        Ok {
                            Name = name
                            InitialCash = initialCash
                            InitialUnitNav = initialUnitNav
                            IsSynthetic = isSynthetic
                        }
                    | Error message, _
                    | _, Error message -> Error message
                | _ ->
                    Error "name, initialCash, initialUnitNav and isSynthetic are required"
        with
        | :? JsonException -> Error "request body must be valid JSON"

    let private 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 parseSipPlanCommand (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 "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 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 parsed = None
                let mutable failure = None
                use targetsElement = document.RootElement.Clone()

                if not (root.TryGetProperty("targets", &targetsElement)) then
                    failure <- Some "targets is required"
                elif targetsElement.ValueKind <> JsonValueKind.Array then
                    failure <- Some "targets must be an array"
                else
                    let rows = ResizeArray<RebalanceTarget>()
                    let mutable rowError = None

                    for item in targetsElement.EnumerateArray() do
                        if rowError.IsNone then
                            match tryStringProperty item "instrumentCode", tryStringProperty item "targetPercent" with
                            | Some code, Some percentText ->
                                match tryDecimal "targetPercent" percentText with
                                | Ok percent -> rows.Add({ InstrumentCode = code; TargetPercent = percent })
                                | Error message -> rowError <- Some message
                            | _ -> rowError <- Some "each target needs instrumentCode and targetPercent"

                    failure <- rowError

                    if failure.IsNone then parsed <- Some { Targets = rows |> Seq.toList }

                match failure with
                | Some message -> Error message
                | None ->
                    match parsed with
                    | Some command -> Ok command
                    | None -> Error "targets is required"
        with
        | :? JsonException -> Error "request body must be valid JSON"

    let private invokeHandler handler next ctx = handler next ctx



    let private unauthorized : HttpHandler =
        setStatusCode 401
        >=> setHttpHeader "WWW-Authenticate" "Bearer"
        >=> 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 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 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)
                POST >=> routef "/funds/%s/sip/plans" (createSipPlan repository)
                GET >=> routef "/funds/%s/sip/plans" (getSipPlans repository)
                POST >=> routef "/funds/%s/sip/advance" (advanceSipPlans 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