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

namespace FundLab.Api

open System
open System.Globalization
open System.Text.Json

type MarketDataInstrument =
    {
        Code: string
        Name: string
        FundType: string option
    }

type MarketDataObservation =
    {
        NavDate: DateOnly
        PublishedAt: DateTimeOffset option
        Nav: decimal
        AccumulatedNav: decimal option
        DailyReturn: decimal option
    }

type MarketDataSearchPayload =
    {
        Source: string
        SourceRevision: string
        CollectedAt: DateTimeOffset
        Instruments: MarketDataInstrument list
    }

type MarketDataNavPayload =
    {
        Source: string
        SourceRevision: string
        CollectedAt: DateTimeOffset
        Code: string
        Observations: MarketDataObservation list
    }

type MarketDataBondQuotePayload =
    {
        Source: string
        SourceRevision: string
        CollectedAt: DateTimeOffset
        Code: string
        Name: string option
        Price: decimal option
        CleanPrice: decimal option
        AccruedInterest: decimal option
        Date: DateOnly option
        MaturityDate: DateOnly option
        ParValue: decimal option
        IssuePrice: decimal option
        ValueDate: DateOnly option
        ListingDate: DateOnly option
        PublishDate: DateOnly option
        PayInterestDay: string option
        CouponRate: decimal option
        CouponRateExplain: string option
        BondExpireYears: string option
        Rating: string option
        DataStatus: string option
    }

type MarketDataStockQuotePayload =
    {
        Source: string
        SourceRevision: string
        CollectedAt: DateTimeOffset
        Code: string
        Name: string option
        Price: decimal option
        Currency: string
        Market: string option
        Adjust: string option
        Suspended: bool option
    }

type MarketDataStockDailyBar =
    {
        BarDate: DateOnly
        Close: decimal
        Volume: decimal option
        Amount: decimal option
    }

type MarketDataStockDailyPayload =
    {
        Source: string
        SourceRevision: string
        CollectedAt: DateTimeOffset
        Code: string
        Market: string option
        Adjust: string option
        Bars: MarketDataStockDailyBar list
    }

type MarketDataInstrumentRecord =
    {
        Code: string
        Name: string
        FundType: string option
        Source: string
        SourceRevision: string
        SourceCollectedAt: DateTimeOffset
        SourcePayloadHash: string
        FirstSeenAt: DateTimeOffset
        LastSeenAt: DateTimeOffset
    }

type MarketDataNavRecord =
    {
        Code: string
        NavDate: DateOnly
        PublishedAt: DateTimeOffset option
        Nav: decimal
        AccumulatedNav: decimal option
        DailyReturn: decimal option
        Source: string
        SourceRevision: string
        SourceCollectedAt: DateTimeOffset
        SourcePayloadHash: string
        FirstSeenAt: DateTimeOffset
        LastSeenAt: DateTimeOffset
    }

module MarketData =
    type private ResultBuilder() =
        member _.Bind(value, binder) = Result.bind binder value
        member _.Return(value) = Ok value
        member _.ReturnFrom(value) = value
        member _.Zero() : Result<unit, string> = Ok ()
        member _.Combine(first: Result<unit, string>, second: unit -> Result<'a, string>) =
            match first with
            | Ok () -> second ()
            | Error message -> Error message
        member _.Delay(generator: unit -> Result<'a, string>) = generator
        member _.Run(generator: unit -> Result<'a, string>) = generator ()

    let private result = ResultBuilder()
    let private invariant = CultureInfo.InvariantCulture

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

        if root.ValueKind <> JsonValueKind.Object then
            Error "payload root must be a JSON object"
        elif root.TryGetProperty(name, &property) then
            Ok property
        else
            Error(sprintf "payload property '%s' is required" name)

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

        if root.ValueKind <> JsonValueKind.Object then
            Error "payload root must be a JSON object"
        elif root.TryGetProperty(name, &property) then
            Ok(Some property)
        else
            Ok None

    let private requiredString (root: JsonElement) name =
        requiredProperty root name
        |> Result.bind (fun property ->
            if property.ValueKind = JsonValueKind.String then
                let value = property.GetString()

                if String.IsNullOrWhiteSpace value then
                    Error(sprintf "payload property '%s' must not be empty" name)
                else
                    Ok value
            else
                Error(sprintf "payload property '%s' must be a string" name))

    let private optionalString (root: JsonElement) name =
        requiredProperty root name
        |> Result.bind (fun property ->
            if property.ValueKind = JsonValueKind.Null then
                Ok None
            elif property.ValueKind = JsonValueKind.String then
                let value = property.GetString()

                if String.IsNullOrWhiteSpace value then
                    Ok None
                else
                    Ok(Some value)
            else
                Error(sprintf "payload property '%s' must be null or a string" name))

    let private optionalBool (root: JsonElement) name =
        optionalProperty root name
        |> Result.bind (function
            | None -> Ok None
            | Some property ->
                match property.ValueKind with
                | JsonValueKind.Null -> Ok None
                | JsonValueKind.True -> Ok(Some true)
                | JsonValueKind.False -> Ok(Some false)
                | _ -> Error(sprintf "payload property '%s' must be null or a boolean" name))

    let private optionalStringOrMissing (root: JsonElement) name =
        optionalProperty root name
        |> Result.bind (function
            | None -> Ok None
            | Some property when property.ValueKind = JsonValueKind.Null -> Ok None
            | Some property when property.ValueKind = JsonValueKind.String ->
                let value = property.GetString()
                if String.IsNullOrWhiteSpace value then Ok None else Ok(Some value)
            | Some _ -> Error(sprintf "payload property '%s' must be null or a string" name))

    let private validateEnvelope root operation =
        result {
            let! schemaVersion = requiredString root "schema_version"
            let! actualOperation = requiredString root "operation"
            let! source = requiredString root "source"
            let! sourceRevision = requiredString root "source_revision"
            let! collectedAtText = requiredString root "collected_at"

            if schemaVersion <> "fund-lab.akshare.v1" then
                return! Error(sprintf "unsupported schema_version '%s'" schemaVersion)

            if actualOperation <> operation then
                return! Error(sprintf "payload operation must be '%s'" operation)

            match DateTimeOffset.TryParse(collectedAtText, invariant, DateTimeStyles.RoundtripKind) with
            | true, collectedAt ->
                return source, sourceRevision, collectedAt
            | false, _ ->
                return! Error "collected_at must be an ISO-8601 timestamp"
        }

    let private isFundCode (value: string) =
        value.Length = 6 && value |> Seq.forall Char.IsDigit

    let private parseFundCode root =
        requiredString root "code"
        |> Result.bind (fun code ->
            if isFundCode code then
                Ok code
            else
                Error "fund code must contain exactly six digits")

    let private parseDate text =
        let mutable date = DateOnly.MinValue

        if DateOnly.TryParseExact(text, "yyyy-MM-dd", invariant, DateTimeStyles.None, &date) then
            Ok date
        else
            Error "nav_date must be an ISO date"

    let private parseDecimal label (property: JsonElement) =
        if property.ValueKind <> JsonValueKind.String then
            Error(sprintf "%s must be a decimal string" label)
        else
            let text = property.GetString()

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

    let private optionalDecimal label (property: JsonElement) =
        if property.ValueKind = JsonValueKind.Null then
            Ok None
        else
            parseDecimal label property |> Result.map Some

    let private optionalPublishedAt (property: JsonElement) =
        if property.ValueKind = JsonValueKind.Null then
            Ok None
        elif property.ValueKind <> JsonValueKind.String then
            Error "published_at must be null or an ISO-8601 timestamp"
        else
            let text = property.GetString()

            if String.IsNullOrWhiteSpace text then
                Error "published_at must be null or an ISO-8601 timestamp"
            else
                match DateTimeOffset.TryParse(text, invariant, DateTimeStyles.RoundtripKind) with
                | true, value -> Ok(Some value)
                | false, _ -> Error "published_at must be null or an ISO-8601 timestamp"

    let private parseArray parser (property: JsonElement) =
        if property.ValueKind <> JsonValueKind.Array then
            Error "payload collection must be a JSON array"
        else
            property.EnumerateArray()
            |> Seq.fold
                (fun state item ->
                    match state, parser item with
                    | Ok values, Ok value -> Ok(value :: values)
                    | Error message, _ -> Error message
                    | _, Error message -> Error message)
                (Ok [])
            |> Result.map List.rev

    let private parseSearchInstrument root =
        result {
            let! code = parseFundCode root
            let! name = requiredString root "name"
            let! fundType = optionalString root "fund_type"

            return
                {
                    Code = code
                    Name = name
                    FundType = fundType
                }
        }

    let private parseObservation root =
        result {
            let! navDateText = requiredString root "nav_date"
            let! navDate = parseDate navDateText
            let! publishedAtProperty = requiredProperty root "published_at"
            let! publishedAt = optionalPublishedAt publishedAtProperty
            let! navProperty = requiredProperty root "nav"
            let! nav = parseDecimal "nav" navProperty
            let! accumulatedNavProperty = requiredProperty root "accumulated_nav"
            let! accumulatedNav = optionalDecimal "accumulated_nav" accumulatedNavProperty
            let! dailyReturnProperty = requiredProperty root "daily_return"
            let! dailyReturn = optionalDecimal "daily_return" dailyReturnProperty

            return
                {
                    NavDate = navDate
                    PublishedAt = publishedAt
                    Nav = nav
                    AccumulatedNav = accumulatedNav
                    DailyReturn = dailyReturn
                }
        }

    let parseSearchPayload (json: string) : Result<MarketDataSearchPayload, string> =
        try
            use document = JsonDocument.Parse(json)
            let root = document.RootElement

            result {
                let! source, sourceRevision, collectedAt = validateEnvelope root "search"
                let! instrumentsProperty = requiredProperty root "instruments"
                let! instruments = parseArray parseSearchInstrument instrumentsProperty

                return
                    {
                        Source = source
                        SourceRevision = sourceRevision
                        CollectedAt = collectedAt
                        Instruments = instruments
                    }
            }
        with
        | :? JsonException -> Error "payload must be valid JSON"

    let parseNavPayload (json: string) : Result<MarketDataNavPayload, string> =
        try
            use document = JsonDocument.Parse(json)
            let root = document.RootElement

            result {
                let! source, sourceRevision, collectedAt = validateEnvelope root "nav"
                let! instrumentProperty = requiredProperty root "instrument"
                let! code = parseFundCode instrumentProperty
                let! observationsProperty = requiredProperty root "observations"
                let! observations = parseArray parseObservation observationsProperty

                if List.isEmpty observations then
                    return! Error "observations must not be empty"

                return
                    {
                        Source = source
                        SourceRevision = sourceRevision
                        CollectedAt = collectedAt
                        Code = code
                        Observations = observations
                    }
            }
        with
        | :? JsonException -> Error "payload must be valid JSON"

    let parseBondQuotePayload (json: string) : Result<MarketDataBondQuotePayload, string> =
        let optionalIsoDate label (property: JsonElement) =
            if property.ValueKind = JsonValueKind.Null then
                Ok None
            elif property.ValueKind <> JsonValueKind.String then
                Error(sprintf "%s must be null or an ISO date" label)
            else
                let text = property.GetString()
                let mutable date = DateOnly.MinValue

                if
                    not (String.IsNullOrWhiteSpace text)
                    && DateOnly.TryParseExact(text, "yyyy-MM-dd", invariant, DateTimeStyles.None, &date)
                then
                    Ok(Some date)
                else
                    Error(sprintf "%s must be null or an ISO date" label)

        try
            use document = JsonDocument.Parse(json)
            let root = document.RootElement

            result {
                let! source, sourceRevision, collectedAt = validateEnvelope root "bond-quote"
                let! instrumentProperty = requiredProperty root "instrument"
                let! codeProperty = requiredString instrumentProperty "code"

                if not (isFundCode codeProperty) then
                    return! Error "bond code must contain exactly six digits"

                let! quoteProperty = requiredProperty root "quote"
                let! name = optionalString quoteProperty "name"
                let! priceProperty = requiredProperty quoteProperty "price"
                let! price = optionalDecimal "price" priceProperty
                let optionalDecimalField fieldName =
                    optionalProperty quoteProperty fieldName
                    |> Result.bind (function
                        | Some property -> optionalDecimal fieldName property
                        | None -> Ok None)

                let optionalDateField fieldName =
                    optionalProperty quoteProperty fieldName
                    |> Result.bind (function
                        | Some property -> optionalIsoDate fieldName property
                        | None -> Ok None)

                let optionalStringField fieldName =
                    optionalProperty quoteProperty fieldName
                    |> Result.bind (function
                        | Some property when property.ValueKind = JsonValueKind.Null -> Ok None
                        | Some property when property.ValueKind = JsonValueKind.String ->
                            let value = property.GetString()
                            if String.IsNullOrWhiteSpace value then Ok None else Ok(Some value)
                        | Some _ -> Error(sprintf "payload property '%s' must be null or a string" fieldName)
                        | None -> Ok None)

                let! cleanPrice = optionalDecimalField "clean_price"
                let! accruedInterest = optionalDecimalField "accrued_interest"
                let! date = optionalDateField "date"
                let! maturityProperty = requiredProperty quoteProperty "maturity_date"
                let! maturityDate = optionalIsoDate "maturity_date" maturityProperty
                let! parValue = optionalDecimalField "par_value"
                let! issuePrice = optionalDecimalField "issue_price"
                let! valueDate = optionalDateField "value_date"
                let! listingDate = optionalDateField "listing_date"
                let! publishDate = optionalDateField "publish_date"
                let! payInterestDay = optionalStringField "pay_interest_day"
                let! couponRate = optionalDecimalField "coupon_rate"
                let! couponRateExplain = optionalStringField "coupon_rate_explain"
                let! bondExpireYears = optionalStringField "bond_expire_years"
                let! rating = optionalStringField "rating"
                let! dataStatus = optionalStringField "data_status"

                return
                    {
                        Source = source
                        SourceRevision = sourceRevision
                        CollectedAt = collectedAt
                        Code = codeProperty
                        Name = name
                        Price = price
                        CleanPrice = cleanPrice
                        AccruedInterest = accruedInterest
                        Date = date
                        MaturityDate = maturityDate
                        ParValue = parValue
                        IssuePrice = issuePrice
                        ValueDate = valueDate
                        ListingDate = listingDate
                        PublishDate = publishDate
                        PayInterestDay = payInterestDay
                        CouponRate = couponRate
                        CouponRateExplain = couponRateExplain
                        BondExpireYears = bondExpireYears
                        Rating = rating
                        DataStatus = dataStatus
                    }
            }
        with
        | :? JsonException -> Error "payload must be valid JSON"

    let parseStockQuotePayload (json: string) : Result<MarketDataStockQuotePayload, string> =
        try
            use document = JsonDocument.Parse(json)
            let root = document.RootElement

            result {
                let! source, sourceRevision, collectedAt = validateEnvelope root "stock-quote"
                let! instrumentProperty = requiredProperty root "instrument"
                let! codeProperty = requiredString instrumentProperty "code"

                if not (isFundCode codeProperty) then
                    return! Error "stock code must contain exactly six digits"

                let! quoteProperty = requiredProperty root "quote"
                let! name = optionalString quoteProperty "name"
                let! priceProperty = requiredProperty quoteProperty "price"
                let! price = optionalDecimal "price" priceProperty
                let! currency = requiredString quoteProperty "currency"
                let! market = optionalStringOrMissing quoteProperty "market"
                let! adjust = optionalStringOrMissing quoteProperty "adjust"
                let! suspended = optionalBool quoteProperty "suspended"

                return
                    {
                        Source = source
                        SourceRevision = sourceRevision
                        CollectedAt = collectedAt
                        Code = codeProperty
                        Name = name
                        Price = price
                        Currency = currency
                        Market = market
                        Adjust = adjust
                        Suspended = suspended
                    }
            }
        with
        | :? JsonException -> Error "payload must be valid JSON"

    let private parseStockDailyBar root =
        result {
            let! dateText = requiredString root "date"
            let! date = parseDate dateText
            let! closeProperty = requiredProperty root "close"
            let! close = parseDecimal "close" closeProperty
            let! volumeProperty = requiredProperty root "volume"
            let! volume = optionalDecimal "volume" volumeProperty
            let! amountProperty = requiredProperty root "amount"
            let! amount = optionalDecimal "amount" amountProperty

            return
                {
                    BarDate = date
                    Close = close
                    Volume = volume
                    Amount = amount
                }
        }

    let parseStockDailyPayload (json: string) : Result<MarketDataStockDailyPayload, string> =
        try
            use document = JsonDocument.Parse(json)
            let root = document.RootElement

            result {
                let! source, sourceRevision, collectedAt = validateEnvelope root "stock-daily"
                let! instrumentProperty = requiredProperty root "instrument"
                let! codeProperty = requiredString instrumentProperty "code"

                if not (isFundCode codeProperty) then
                    return! Error "stock code must contain exactly six digits"

                let! observationsProperty = requiredProperty root "observations"
                let! barsProperty = requiredProperty root "observations"
                let! bars = parseArray parseStockDailyBar barsProperty

                if List.isEmpty bars then
                    return! Error "observations must not be empty"

                let! market = optionalStringOrMissing root "market"
                let! adjust = optionalStringOrMissing root "adjust"

                return
                    {
                        Source = source
                        SourceRevision = sourceRevision
                        CollectedAt = collectedAt
                        Code = codeProperty
                        Market = market
                        Adjust = adjust
                        Bars = bars
                    }
            }
        with
        | :? JsonException -> Error "payload must be valid JSON"