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

namespace FundLab.Api

open System
open System.Globalization
open System.IO
open System.Text.Json
open Giraffe
open Microsoft.AspNetCore.Http

type EmptyPortfolioResponse =
    {
        status: string
        message: string
    }

type FundApiResponse =
    {
        id: Guid
        name: string
        currency: string
        initialCash: string
        initialUnitNav: string
        isSynthetic: bool
        availableCash: string
        status: 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 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
            status = fund.Status
        }

    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 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 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()) 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 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
                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