diff --git a/src/Funogram.Tests/Constants.fs b/src/Funogram.Tests/Constants.fs index 8642029..748766c 100644 --- a/src/Funogram.Tests/Constants.fs +++ b/src/Funogram.Tests/Constants.fs @@ -8,7 +8,7 @@ open Funogram.Types module Constants = let private ok = sprintf """{"ok":true,"result":%s}""" - let testDate = System.DateTime(2117, 05, 28, 12, 47, 51, DateTimeKind.Utc) + let testDate = DateTime(2117, 05, 28, 12, 47, 51, DateTimeKind.Utc) let testDateUnix = 4651649271L let testForwardOrigin = MessageOrigin.HiddenUser( MessageOriginHiddenUser.Create( @@ -39,8 +39,8 @@ module Constants = let jsonTestEditResult3ApiString = """{"ok":true,"result":{"message_id":123,"from":{"id":321,"is_bot":true,"first_name":"FSharpBot","username":"FSharpBot"},"chat":{"id":123,"first_name":"Test","last_name":"Test","username":"test","type":"private"},"date":4651649271,"edit_date":4651649271,"text":"Updated"}}""" - let testMaskPosition = { MaskPosition.Point = MaskPoint.Eyes; XShift = 0.0; YShift = 0.0; Scale = 0.0 } - let jsonTestMaskPosition = """{"point":"eyes","x_shift":0,"y_shift":0,"scale":0}""" + let testMaskPosition = { MaskPosition.Point = MaskPoint.Eyes; XShift = 1.0; YShift = 2.0; Scale = 3.0 } + let jsonTestMaskPosition = """{"point":"eyes","x_shift":1,"y_shift":2,"scale":3}""" let jsonTestMaskPositionResult = ok jsonTestMaskPosition diff --git a/src/Funogram/Funogram.fsproj b/src/Funogram/Funogram.fsproj index 18a1057..879d5f1 100644 --- a/src/Funogram/Funogram.fsproj +++ b/src/Funogram/Funogram.fsproj @@ -24,10 +24,9 @@ + - - diff --git a/src/Funogram/Resolvers.fs b/src/Funogram/Resolvers.fs index eeba3e7..d310fa7 100644 --- a/src/Funogram/Resolvers.fs +++ b/src/Funogram/Resolvers.fs @@ -1,18 +1,18 @@ namespace Funogram open System +open System.Collections.Generic open System.IO open System.Runtime.CompilerServices open System.Runtime.Serialization open System.Text -open Utf8Json +open System.Text.Json +open System.Text.Json.Serialization +open TypeShape.Core [] do () module internal Resolvers = - - open TypeShape.Core - let getSnakeCaseName (name: string) = let chars = seq { @@ -30,6 +30,9 @@ module internal Resolvers = else yield c } String.Concat(chars).ToLower() + + let private unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + let toUnix (x: DateTime) = (x.ToUniversalTime() - unixEpoch).TotalSeconds |> int64 let mkMemberSerializer (case: ShapeFSharpUnionCase<'DeclaringType>) = let isFile = @@ -38,44 +41,60 @@ module internal Resolvers = && (case.Fields[1].Member.Type = typeof || case.Fields[1].Member.Type = typeof) if case.Fields.Length = 0 then - fun _ _ -> Encoding.UTF8.GetBytes(getSnakeCaseName case.CaseInfo.Name |> sprintf "\"%s\"") + fun (writer: Utf8JsonWriter) _ options -> + let name = getSnakeCaseName case.CaseInfo.Name + writer.WriteStringValue(name) + // Encoding.UTF8.GetBytes(getSnakeCaseName case.CaseInfo.Name |> sprintf "\"%s\"") else - case.Fields.[0].Accept { new IMemberVisitor<'DeclaringType, 'DeclaringType -> IJsonFormatterResolver -> byte[]> with + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, Utf8JsonWriter -> 'DeclaringType -> JsonSerializerOptions -> unit> with member _.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = - fun value resolver -> - let mutable myWriter = JsonWriter() - + fun writer value options -> if isFile then let str = box (shape.Get value) |> unbox - myWriter.WriteString(sprintf "attach://%s" str) + writer.WriteStringValue($"attach://{str}") else - resolver.GetFormatterWithVerify<'Field>() - .Serialize(&myWriter, shape.Get value, resolver) - myWriter.ToUtf8ByteArray() + let v = shape.Get value + let converter = options.GetConverter(v.GetType()) + let c = converter :?> JsonConverter<'a> + c.Write(writer, v, options) } + [] + type IUnionDeserializer<'T> = + abstract member Deserialize: reader: byref * options: JsonSerializerOptions -> 'T + + type CaseFullDeserializer<'DeclaringType, 'Field>(shape: ShapeMember<'DeclaringType, 'Field>, init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, options: JsonSerializerOptions) = + let converter = options.GetConverter(typeof<'DeclaringType>) :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'DeclaringType>, options) |> shape.Set (init ()) + + type CaseNameDeserializer<'DeclaringType>(init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, options: JsonSerializerOptions) = + reader.Read() |> ignore + init () + let mkMemberDeserializer (case: ShapeFSharpUnionCase<'DeclaringType>) (init: unit -> 'DeclaringType) = if case.Fields.Length = 0 then - fun value offset _ -> - let mutable myReader = JsonReader(value, offset) - myReader.ReadNext() - let offset = myReader.GetCurrentOffsetUnsafe() - (init(), offset) + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, _) = + //reader.Read() |> ignore + init () + } else - case.Fields.[0].Accept { new IMemberVisitor<'DeclaringType, byte[] -> int -> IJsonFormatterResolver -> ('DeclaringType * int)> with - member __.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = - fun value offset resolver -> - let mutable myReader = JsonReader(value, offset) - let v = - resolver.GetFormatterWithVerify<'Field>() - .Deserialize(&myReader, resolver) - let offset = myReader.GetCurrentOffsetUnsafe() - (shape.Set (init()) v, offset) - } + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, IUnionDeserializer<'DeclaringType>> with + member x.Visit (shape: ShapeMember<'DeclaringType, 'Field>) = + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, options) = + let converter = options.GetConverter(typeof<'Field>) + let converter = converter :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'Field>, options) |> shape.Set (init ()) + } + } - type FunogramDiscriminatedUnionFormatter<'a>() = + type DiscriminatedUnionConverter<'a>() = + inherit JsonConverter<'a>() - let shape = Core.shapeof<'a> + let shape = shapeof<'a> let union = match shape with | Shape.FSharpUnion (:? ShapeFSharpUnion<'a> as union) -> union @@ -109,7 +128,7 @@ module internal Resolvers = let serializers = union.UnionCases - |> Seq.map (fun case -> mkMemberSerializer case) + |> Seq.map mkMemberSerializer |> Seq.toArray let deserializers = @@ -117,111 +136,110 @@ module internal Resolvers = |> Seq.map (fun case -> mkMemberDeserializer case case.CreateUninitialized) |> Seq.toArray - // this serializer/deserializer is used to match union case by set of fields - interface IJsonFormatter<'a> with - member x.Serialize(writer, value, resolver) = - let serialize = serializers.[union.GetTag value] // all union cases - writer.WriteRaw(serialize value resolver) + override x.Write(writer, value, options) = + let serialize = serializers[union.GetTag value] // all union cases + serialize writer value options + + member x.ReadCasesOnly(reader: byref) = + let mutable types: Type list = [] + let caseNames = List() + + let reader = reader // copy reader + let mutable loop = true + let mutable first = true + + if reader.TokenType = JsonTokenType.StartObject then + reader.Read() |> ignore - member x.Deserialize(reader, resolver) = - // read list of properties - let mutable loop = true - - let buffer = reader.GetBufferUnsafe() - let offset = reader.GetCurrentOffsetUnsafe() - - let propReader = JsonReader(buffer, offset) - let mutable readProperty = false - let mutable level = 0 - let mutable types: Type list = [] - - let (jsonCaseNames, jsonCaseTypes) = - (seq { - while loop do - let token = propReader.GetCurrentJsonToken() - - if level = 0 && token <> JsonToken.BeginObject && enumUnion |> not then - types <- - match token with - | JsonToken.True | JsonToken.False -> [typeof] - | JsonToken.String -> - [typeof] - | JsonToken.Number -> [typeof;typeof;typeof;typeof] - | _ -> failwith "Unknown type!" - loop <- false - else if enumUnion then - yield propReader.ReadString() - loop <- false - else - match token with - | JsonToken.BeginObject -> - level <- level + 1 - readProperty <- true - | JsonToken.EndObject -> - level <- level - 1 - | JsonToken.ValueSeparator -> - readProperty <- true - | JsonToken.None -> loop <- false - | _ -> () - - if readProperty && level = 1 then - propReader.ReadNext() - yield propReader.ReadPropertyName() - readProperty <- false - else if level = 0 then - loop <- false - else - readProperty <- false - propReader.ReadNext() - } |> Seq.toList, types) - - let idx = - cases - |> Array.tryFindIndex (fun (caseNames, tp) -> - (jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value)) - && jsonCaseNames |> Seq.forall (fun n -> - caseNames |> Set.contains n)) - match idx with - | Some idx -> - let value, newOffset = deserializers.[idx] buffer offset resolver - reader.AdvanceOffset(newOffset - offset) - value - | None -> - // try to find most similar type - let item = - cases |> Array.maxBy (fun (caseNames, tp) -> - if jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value) then - jsonCaseNames |> Seq.sumBy (fun n -> if caseNames |> Set.contains n then 1 else 0) - else - -1 - ) - - let idx = cases |> Array.findIndex (fun x -> x = item) - let value, newOffset = deserializers.[idx] buffer offset resolver - reader.AdvanceOffset(newOffset - offset) - value - // failwithf "Internal error: Cannot match type \"%s\" by fields. Please create issue on https://github.com/Dolfik1/Funogram/issues" typeof<'a>.FullName + while loop do + let token = reader.TokenType + if first && not enumUnion then + loop <- false + types <- + match token with + | JsonTokenType.True | JsonTokenType.False -> [typeof] + | JsonTokenType.String -> [typeof] + | JsonTokenType.Number -> [typeof;typeof;typeof;typeof] + | _ -> + types + + if types.Length > 0 then + loop <- false - let private unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) - let toUnix (x: DateTime) = (x.ToUniversalTime() - unixEpoch).TotalSeconds |> int64 - - type FunogramUnixTimestampDateTimeFormatter() = - let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) - interface IJsonFormatter with - member x.Serialize(writer, value, _) = - writer.WriteInt64(toUnix value) - - member x.Deserialize(reader, _) = - let v = reader.ReadInt64() |> float - unixEpoch.AddSeconds(v) - - type FunogramResolver() = - interface IJsonFormatterResolver with - member x.GetFormatter<'a>(): IJsonFormatter<'a> = - match shapeof<'a> with - | Shape.FSharpOption _ -> null - | Shape.FSharpUnion _ -> - FunogramDiscriminatedUnionFormatter<'a>() :> IJsonFormatter<'a> - | _ -> null + first <- false + + if enumUnion then + caseNames.Add(reader.GetString()) + reader.Read() |> ignore + loop <- false + else + match token with + | JsonTokenType.PropertyName -> + caseNames.Add(reader.GetString()) + | JsonTokenType.StartObject + | JsonTokenType.StartArray -> + reader.Skip() + | _ -> () + + loop <- reader.Read() + + caseNames, types + + override x.Read(reader, _, options) = + // read list of properties + let t = typeof<'a> + + let jsonCaseNames, jsonCaseTypes = x.ReadCasesOnly(&reader) + + let idx = + cases + |> Array.tryFindIndex (fun (caseNames, tp) -> + (jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value)) + && jsonCaseNames |> Seq.forall (fun n -> + caseNames |> Set.contains n)) + + match idx with + | Some idx -> + deserializers[idx].Deserialize(&reader, options) + | None -> + // try to find most similar type + let item = + cases |> Array.maxBy (fun (caseNames, tp) -> + if jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value) then + jsonCaseNames |> Seq.sumBy (fun n -> if caseNames |> Set.contains n then 1 else 0) + else + -1 + ) + + let idx = cases |> Array.findIndex (fun x -> x = item) + deserializers[idx].Deserialize(&reader, options) - static member Instance = FunogramResolver() \ No newline at end of file + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type DiscriminatedUnionConverterFactory() = + inherit JsonConverterFactory() + + override x.CreateConverter(typeToConvert, options) = + let g = typedefof>.MakeGenericType(typeToConvert) + Activator.CreateInstance(g) :?> JsonConverter + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type UnixTimestampDateTimeConverter() = + inherit JsonConverter() + let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + + override x.Read(reader, _, _) = + let v = reader.GetInt64() |> float + unixEpoch.AddSeconds(v) + + override x.Write(writer, value, _) = + writer.WriteNumberValue(toUnix value) \ No newline at end of file diff --git a/src/Funogram/Tools.fs b/src/Funogram/Tools.fs index 95841f8..78e6488 100644 --- a/src/Funogram/Tools.fs +++ b/src/Funogram/Tools.fs @@ -5,9 +5,9 @@ open System.Net open System.Net.Http open System.Runtime.CompilerServices open System.Text +open System.Text.Json +open System.Text.Json.Serialization open Funogram.Types -open Utf8Json -open Utf8Json.Resolvers [] [] @@ -18,23 +18,33 @@ open System.IO open System.Linq.Expressions open Funogram.Resolvers open TypeShape.Core -open Utf8Json.FSharp - -let internal formatters: IJsonFormatter[] = [| - FunogramUnixTimestampDateTimeFormatter() -|] - -let internal resolvers: IJsonFormatterResolver[] =[| - FunogramResolver.Instance - FSharpResolver.Instance - StandardResolver.ExcludeNullSnakeCase -|] - -let internal resolver = - Resolvers.CompositeResolver.Create( - formatters, - resolvers - ) +// +// let internal formatters: IJsonFormatter[] = [| +// FunogramUnixTimestampDateTimeFormatter() +// |] +// +// let internal resolvers: IJsonFormatterResolver[] =[| +// FunogramResolver.Instance +// FSharpResolver.Instance +// StandardResolver.ExcludeNullSnakeCase +// |] +// +// let internal resolver = +// Resolvers.CompositeResolver.Create( +// formatters, +// resolvers +// ) + +let internal options = + let o = + JsonSerializerOptions( + WriteIndented = false, + PropertyNamingPolicy = JsonNamingPolicy.SnakeCaseLower, + DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull + ) + o.Converters.Add(DiscriminatedUnionConverterFactory()) + o.Converters.Add(UnixTimestampDateTimeConverter()) + o let private getUrl (config: BotConfig) methodName = let botToken = sprintf "%s%s" (config.ApiEndpointUrl |> string) config.Token @@ -49,22 +59,22 @@ let internal getUnix (date: DateTime) = let internal parseJson<'a> (data: byte[]) = try - match JsonSerializer.Deserialize>(data, resolver) with + match JsonSerializer.Deserialize>(data, options) with | x when x.Ok && x.Result.IsSome -> Ok x.Result.Value | x when x.Description.IsSome && x.ErrorCode.IsSome -> Error { Description = x.Description.Value ErrorCode = x.ErrorCode.Value } - | _ -> + | x -> Error { Description = "Unknown error" ErrorCode = -1 } with ex -> - let json = System.Text.Encoding.UTF8.GetString data + let json = Encoding.UTF8.GetString data let message = sprintf "%s in %s" ex.Message json ArgumentException(message, ex) |> raise let internal parseJsonStream<'a> (data: Stream) = try - JsonSerializer.Deserialize<'a>(data, resolver) |> Ok + JsonSerializer.Deserialize<'a>(data, options) |> Ok with ex -> if data.CanSeek then data.Seek(0L, SeekOrigin.Begin) |> ignore @@ -88,7 +98,7 @@ let internal parseJsonStreamApiResponse<'a> (data: Stream) = Error { Description = "Unknown error"; ErrorCode = -1 } [] -let toJson (o: 'a) = JsonSerializer.Serialize<'a>(o, resolver) +let toJson (o: 'a) = JsonSerializer.SerializeToUtf8Bytes<'a>(o, options) let private toJsonMethodInfo = System.Reflection.Assembly.GetExecutingAssembly() @@ -246,7 +256,7 @@ module Api = let casePrinters = cases |> Array.map mkUnionCasePrinter // generate printers for all union cases fun (u:'T) -> let tag : int = shape.GetTag u // get the underlying tag for the union case - casePrinters.[tag] u + casePrinters[tag] u | _ -> fun _ -> [||] let multipartSerializers = ConcurrentDictionary MultipartFormDataContent -> bool>() @@ -445,8 +455,8 @@ module Api = let url = getUrl config request.MethodName use ms = new MemoryStream() - JsonSerializer.Serialize(ms, request, resolver) - + JsonSerializer.Serialize(ms, request, options) + use content = new StreamContent(ms) let! result = client.PostAsync(url, content) |> Async.AwaitTask