├── .editorconfig ├── .gitattributes ├── .gitignore ├── CHANGELOG.md ├── Directory.Build.props ├── Directory.Build.targets ├── FsCodec.sln ├── FsCodec.sln.DotSettings ├── LICENSE ├── README.md ├── SECURITY.md ├── azure-pipelines.yml ├── build.proj ├── global.json ├── src ├── FsCodec.Box │ ├── ByteArray.fs │ ├── Codec.fs │ ├── Compression.fs │ ├── CoreCodec.fs │ └── FsCodec.Box.fsproj ├── FsCodec.NewtonsoftJson │ ├── Codec.fs │ ├── FsCodec.NewtonsoftJson.fsproj │ ├── OptionConverter.fs │ ├── Options.fs │ ├── Pickler.fs │ ├── Serdes.fs │ ├── StringIdConverter.fs │ ├── TypeSafeEnumConverter.fs │ ├── UnionConverter.fs │ └── VerbatimUtf8Converter.fs ├── FsCodec.SystemTextJson │ ├── Codec.fs │ ├── CodecJsonElement.fs │ ├── Encoding.fs │ ├── FsCodec.SystemTextJson.fsproj │ ├── Interop.fs │ ├── Options.fs │ ├── Pickler.fs │ ├── RejectNullStringConverter.fs │ ├── Serdes.fs │ ├── StringIdConverter.fs │ ├── TypeSafeEnumConverter.fs │ ├── UnionConverter.fs │ └── UnionOrTypeSafeEnumConverterFactory.fs └── FsCodec │ ├── Codec.fs │ ├── Encoding.fs │ ├── FsCodec.fs │ ├── FsCodec.fsproj │ ├── StreamId.fs │ ├── StreamName.fs │ ├── StringId.fs │ ├── TypeSafeEnum.fs │ └── Union.fs └── tests ├── FsCodec.NewtonsoftJson.Tests ├── Examples.fsx ├── Fixtures.fs ├── FsCodec.NewtonsoftJson.Tests.fsproj ├── PicklerTests.fs ├── SomeNullHandlingTests.fs ├── StreamTests.fs ├── UnionConverterTests.fs └── VerbatimUtf8ConverterTests.fs ├── FsCodec.SystemTextJson.Tests ├── AutoUnionTests.fs ├── CodecTests.fs ├── EncodingTests.fs ├── Examples.fsx ├── FsCodec.SystemTextJson.Tests.fsproj ├── InteropTests.fs ├── PicklerTests.fs ├── SerdesTests.fs ├── StringIdTests.fs ├── TypeSafeEnumConverterTests.fs └── UmxInteropTests.fs └── FsCodec.Tests ├── EncodingTests.fs ├── FsCodec.Tests.fsproj ├── StreamNameTests.fs └── TypeSafeEnumTests.fs /.editorconfig: -------------------------------------------------------------------------------- 1 | root = true 2 | 3 | 4 | [*.fs] 5 | indent_style = space 6 | indent_size = 4 7 | trim_trailing_whitespace = true 8 | insert_final_newline = true 9 | end_of_line = lf 10 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # OS 2 | 3 | ## Mac 4 | 5 | .DS_Store 6 | 7 | # User-specific files 8 | 9 | # Test results 10 | *.trx 11 | 12 | # Build results 13 | .build/ 14 | [Bb]in/ 15 | [Oo]bj/ 16 | 17 | # Visual Studio 2015+ cache/options directory 18 | .vs/ 19 | 20 | # ReSharper is a .NET coding add-in 21 | _ReSharper*/ 22 | *.[Rr]e[Ss]harper 23 | *.DotSettings.user 24 | 25 | # NCrunch 26 | _NCrunch_* 27 | .*crunch*.local.xml 28 | nCrunchTemp_* 29 | 30 | # NuGet Packages 31 | *.nupkg 32 | packages.config 33 | # The packages folder can be ignored because of Package Restore 34 | **/packages/* 35 | 36 | # JetBrains Rider 37 | .idea/ 38 | *.sln.iml 39 | 40 | # CodeRush 41 | .cr/ -------------------------------------------------------------------------------- /Directory.Build.props: -------------------------------------------------------------------------------- 1 | 2 | 3 | @jet @moneylion @amjjd @bartelink @eiriktsarpalis and contributors 4 | Jet.com 5 | Extensible F# Event Codec for System.Text.Json and Newtonsoft.Json with versioning tolerant converters 6 | https://github.com/jet/FsCodec 7 | fsharp unionconverter eventcodec JsonPickler JsonIsomorphism UnionConverter json converters typeshape 8 | Apache-2.0 9 | Copyright © 2016-25 10 | 11 | 12 | true 13 | 5 14 | true 15 | true 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /Directory.Build.targets: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | $(MinVerMajor).$(MinVerMinor).$(MinVerPatch)-pr.$(BUILD_PR) 5 | $(PackageVersion).$(MinVerPreRelease) 6 | $(PackageVersion)+$(MinVerBuildMetadata) 7 | $(PackageVersion) 8 | 9 | 10 | 11 | 12 | 0 13 | $(MinVerMajor).$(MinVerMinor).$(MinVerPatch).$(BUILD_ID) 14 | 15 | 16 | -------------------------------------------------------------------------------- /FsCodec.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 15 4 | VisualStudioVersion = 15.0.26124.0 5 | MinimumVisualStudioVersion = 15.0.26124.0 6 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FsCodec.NewtonsoftJson", "src\FsCodec.NewtonsoftJson\FsCodec.NewtonsoftJson.fsproj", "{ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}" 7 | EndProject 8 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FsCodec.NewtonsoftJson.Tests", "tests\FsCodec.NewtonsoftJson.Tests\FsCodec.NewtonsoftJson.Tests.fsproj", "{F05E2B06-DC4C-4D27-8DA8-370F96364739}" 9 | EndProject 10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".project", ".project", "{1D0127A7-2F3E-4CEF-90C6-621DA1192875}" 11 | ProjectSection(SolutionItems) = preProject 12 | azure-pipelines.yml = azure-pipelines.yml 13 | build.proj = build.proj 14 | Directory.Build.props = Directory.Build.props 15 | Directory.Build.targets = Directory.Build.targets 16 | global.json = global.json 17 | LICENSE = LICENSE 18 | README.md = README.md 19 | SECURITY.md = SECURITY.md 20 | CHANGELOG.md = CHANGELOG.md 21 | EndProjectSection 22 | EndProject 23 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsCodec", "src\FsCodec\FsCodec.fsproj", "{9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}" 24 | EndProject 25 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsCodec.Tests", "tests\FsCodec.Tests\FsCodec.Tests.fsproj", "{0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}" 26 | EndProject 27 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsCodec.SystemTextJson", "src\FsCodec.SystemTextJson\FsCodec.SystemTextJson.fsproj", "{1A27C90F-85EE-4AE6-A27B-183D0D50F62E}" 28 | EndProject 29 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsCodec.SystemTextJson.Tests", "tests\FsCodec.SystemTextJson.Tests\FsCodec.SystemTextJson.Tests.fsproj", "{5C57C6D6-59AB-426F-9999-FDB90864545E}" 30 | EndProject 31 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsCodec.Box", "src\FsCodec.Box\FsCodec.Box.fsproj", "{93AF284E-BD31-456E-96AC-162C746F9479}" 32 | EndProject 33 | Global 34 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 35 | Debug|Any CPU = Debug|Any CPU 36 | Debug|x64 = Debug|x64 37 | Debug|x86 = Debug|x86 38 | Release|Any CPU = Release|Any CPU 39 | Release|x64 = Release|x64 40 | Release|x86 = Release|x86 41 | EndGlobalSection 42 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 43 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 44 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|Any CPU.Build.0 = Debug|Any CPU 45 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|x64.ActiveCfg = Debug|Any CPU 46 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|x64.Build.0 = Debug|Any CPU 47 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|x86.ActiveCfg = Debug|Any CPU 48 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Debug|x86.Build.0 = Debug|Any CPU 49 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|Any CPU.ActiveCfg = Release|Any CPU 50 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|Any CPU.Build.0 = Release|Any CPU 51 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|x64.ActiveCfg = Release|Any CPU 52 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|x64.Build.0 = Release|Any CPU 53 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|x86.ActiveCfg = Release|Any CPU 54 | {ACB412D4-AB3D-4594-BD97-84EA97E2BE7B}.Release|x86.Build.0 = Release|Any CPU 55 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 56 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|Any CPU.Build.0 = Debug|Any CPU 57 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|x64.ActiveCfg = Debug|Any CPU 58 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|x64.Build.0 = Debug|Any CPU 59 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|x86.ActiveCfg = Debug|Any CPU 60 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Debug|x86.Build.0 = Debug|Any CPU 61 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|Any CPU.ActiveCfg = Release|Any CPU 62 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|Any CPU.Build.0 = Release|Any CPU 63 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|x64.ActiveCfg = Release|Any CPU 64 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|x64.Build.0 = Release|Any CPU 65 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|x86.ActiveCfg = Release|Any CPU 66 | {F05E2B06-DC4C-4D27-8DA8-370F96364739}.Release|x86.Build.0 = Release|Any CPU 67 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 68 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|Any CPU.Build.0 = Debug|Any CPU 69 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|x64.ActiveCfg = Debug|Any CPU 70 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|x64.Build.0 = Debug|Any CPU 71 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|x86.ActiveCfg = Debug|Any CPU 72 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Debug|x86.Build.0 = Debug|Any CPU 73 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|Any CPU.ActiveCfg = Release|Any CPU 74 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|Any CPU.Build.0 = Release|Any CPU 75 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|x64.ActiveCfg = Release|Any CPU 76 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|x64.Build.0 = Release|Any CPU 77 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|x86.ActiveCfg = Release|Any CPU 78 | {9D2A9566-9C80-4AF3-A487-76A9FE8CBE64}.Release|x86.Build.0 = Release|Any CPU 79 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 80 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|Any CPU.Build.0 = Debug|Any CPU 81 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|x64.ActiveCfg = Debug|Any CPU 82 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|x64.Build.0 = Debug|Any CPU 83 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|x86.ActiveCfg = Debug|Any CPU 84 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Debug|x86.Build.0 = Debug|Any CPU 85 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|Any CPU.ActiveCfg = Release|Any CPU 86 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|Any CPU.Build.0 = Release|Any CPU 87 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|x64.ActiveCfg = Release|Any CPU 88 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|x64.Build.0 = Release|Any CPU 89 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|x86.ActiveCfg = Release|Any CPU 90 | {0A1529E7-8DEF-4B2B-9737-3DB7BD3F1954}.Release|x86.Build.0 = Release|Any CPU 91 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 92 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|Any CPU.Build.0 = Debug|Any CPU 93 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|x64.ActiveCfg = Debug|Any CPU 94 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|x64.Build.0 = Debug|Any CPU 95 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|x86.ActiveCfg = Debug|Any CPU 96 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Debug|x86.Build.0 = Debug|Any CPU 97 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|Any CPU.ActiveCfg = Release|Any CPU 98 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|Any CPU.Build.0 = Release|Any CPU 99 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|x64.ActiveCfg = Release|Any CPU 100 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|x64.Build.0 = Release|Any CPU 101 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|x86.ActiveCfg = Release|Any CPU 102 | {1A27C90F-85EE-4AE6-A27B-183D0D50F62E}.Release|x86.Build.0 = Release|Any CPU 103 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 104 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|Any CPU.Build.0 = Debug|Any CPU 105 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|x64.ActiveCfg = Debug|Any CPU 106 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|x64.Build.0 = Debug|Any CPU 107 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|x86.ActiveCfg = Debug|Any CPU 108 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Debug|x86.Build.0 = Debug|Any CPU 109 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|Any CPU.ActiveCfg = Release|Any CPU 110 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|Any CPU.Build.0 = Release|Any CPU 111 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|x64.ActiveCfg = Release|Any CPU 112 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|x64.Build.0 = Release|Any CPU 113 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|x86.ActiveCfg = Release|Any CPU 114 | {5C57C6D6-59AB-426F-9999-FDB90864545E}.Release|x86.Build.0 = Release|Any CPU 115 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 116 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|Any CPU.Build.0 = Debug|Any CPU 117 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|x64.ActiveCfg = Debug|Any CPU 118 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|x64.Build.0 = Debug|Any CPU 119 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|x86.ActiveCfg = Debug|Any CPU 120 | {93AF284E-BD31-456E-96AC-162C746F9479}.Debug|x86.Build.0 = Debug|Any CPU 121 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|Any CPU.ActiveCfg = Release|Any CPU 122 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|Any CPU.Build.0 = Release|Any CPU 123 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|x64.ActiveCfg = Release|Any CPU 124 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|x64.Build.0 = Release|Any CPU 125 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|x86.ActiveCfg = Release|Any CPU 126 | {93AF284E-BD31-456E-96AC-162C746F9479}.Release|x86.Build.0 = Release|Any CPU 127 | EndGlobalSection 128 | GlobalSection(SolutionProperties) = preSolution 129 | HideSolutionNode = FALSE 130 | EndGlobalSection 131 | GlobalSection(ExtensibilityGlobals) = postSolution 132 | SolutionGuid = {9E28C5AA-F570-4825-B587-9C4710B199FD} 133 | EndGlobalSection 134 | EndGlobal 135 | -------------------------------------------------------------------------------- /FsCodec.sln.DotSettings: -------------------------------------------------------------------------------- 1 |  2 | True 3 | True 4 | True -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Guidelines for this Project 2 | 3 | ## How the Walmart Security team manages security for this project 4 | Walmart takes security seriously and wants to ensure that we maintain a secure environment for our customers and that we also provide secure solutions for the open source community. To help us achieve these goals, please note the following before using this software: 5 | 6 | - Review the software license to understand Walmart's obligations in terms of warranties and suitability for purpose 7 | - Review our Responsible Disclosure Policy: https://corporate.walmart.com/article/responsible-disclosure-policy 8 | - Report any security concerns or questions using our reporting form at the bottom of our Responsible Disclosure Policy page: https://corporate.walmart.com/article/responsible-disclosure-policy 9 | - We enforce SLAs on our security team and software engineers to remediate security bugs in a timely manner 10 | - Please monitor this repository and update your environment in a timely manner as we release patches and updates 11 | 12 | ## Responsibly Disclosing Security Bugs to Walmart 13 | If you find a security bug in this repository, please work with Walmart's security team following responsible disclosure principles and these guidelines: 14 | 15 | - Do not submit a normal issue or pull request in our public repository, instead report directly on our reporting form found at the bottom of our Responsible Disclosure Policy page: https://corporate.walmart.com/article/responsible-disclosure-policy 16 | - We will review your submission and may follow up for additional details 17 | - If you have a patch, we will review it and approve it privately; once approved for release you can submit it as a pull request publicly in our repos (we give credit where credit is due) 18 | -------------------------------------------------------------------------------- /azure-pipelines.yml: -------------------------------------------------------------------------------- 1 | name: $(Rev:r) 2 | jobs: 3 | - job: Windows 4 | pool: 5 | vmImage: 'windows-latest' 6 | steps: 7 | - script: dotnet test build.proj 8 | displayName: dotnet test 9 | - task: PublishTestResults@2 10 | inputs: 11 | testResultsFormat: 'VSTest' 12 | testResultsFiles: 'tests/**/*.trx' 13 | condition: succeededOrFailed() 14 | - script: dotnet pack build.proj 15 | displayName: dotnet pack build.proj 16 | env: 17 | BUILD_PR: $(SYSTEM.PULLREQUEST.PULLREQUESTNUMBER) 18 | BUILD_ID: $(BUILD.BUILDNUMBER) 19 | - task: PublishBuildArtifacts@1 20 | inputs: 21 | pathtoPublish: 'bin' 22 | artifactName: 'nupkgs' 23 | - job: Linux 24 | pool: 25 | vmImage: 'ubuntu-latest' 26 | steps: 27 | - task: UseDotNet@2 28 | inputs: 29 | useGlobalJson: true 30 | - script: dotnet test build.proj 31 | displayName: dotnet test 32 | - task: PublishTestResults@2 33 | inputs: 34 | testResultsFormat: 'VSTest' 35 | testResultsFiles: 'tests/**/*.trx' 36 | condition: succeededOrFailed() 37 | - script: dotnet pack build.proj 38 | displayName: dotnet pack 39 | - job: MacOS 40 | pool: 41 | vmImage: 'macOS-latest' 42 | steps: 43 | - task: UseDotNet@2 44 | inputs: 45 | useGlobalJson: true 46 | - script: dotnet test build.proj 47 | displayName: dotnet test 48 | - task: PublishTestResults@2 49 | inputs: 50 | testResultsFormat: 'VSTest' 51 | testResultsFiles: 'tests/**/*.trx' 52 | condition: succeededOrFailed() 53 | - script: dotnet pack build.proj 54 | displayName: dotnet pack 55 | -------------------------------------------------------------------------------- /build.proj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | --configuration Release 7 | 8 | /p:BUILD_PR=$(BUILD_PR) 9 | /p:BUILD_ID=$(BUILD_ID) $(PrOption) -o $(MSBuildThisFileDirectory)bin 10 | 11 | --logger:trx 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /global.json: -------------------------------------------------------------------------------- 1 | { 2 | "sdk": { 3 | "version": "9.0.100", 4 | "rollForward": "latestMajor" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /src/FsCodec.Box/ByteArray.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec 2 | 3 | open System 4 | open System.Runtime.CompilerServices 5 | 6 | [] 7 | type ByteArray private () = 8 | 9 | static member BytesToReadOnlyMemory(x: byte[]): ReadOnlyMemory = 10 | if x = null then ReadOnlyMemory.Empty 11 | else ReadOnlyMemory x 12 | 13 | static member ReadOnlyMemoryToBytes(x: ReadOnlyMemory): byte[] = 14 | if x.IsEmpty then null 15 | else x.ToArray() 16 | 17 | /// Adapt an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies to instead use byte[]
18 | /// Ideally not used as it makes pooling problematic; only provided for interop/porting scaffolding wrt Equinox V3 and EventStore.Client etc 19 | [] 20 | static member AsByteArray<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>) 21 | : IEventCodec<'Event, byte[], 'Context> = 22 | FsCodec.Core.EventCodec.mapBodies ByteArray.ReadOnlyMemoryToBytes ByteArray.BytesToReadOnlyMemory native 23 | 24 | [] 25 | static member ToByteArrayCodec<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>) 26 | : IEventCodec<'Event, byte[], 'Context> = 27 | FsCodec.Core.EventCodec.mapBodies ByteArray.ReadOnlyMemoryToBytes ByteArray.BytesToReadOnlyMemory native 28 | -------------------------------------------------------------------------------- /src/FsCodec.Box/Codec.fs: -------------------------------------------------------------------------------- 1 | // Mirror of FsCodec.NewtonsoftJson/SystemTextJson.Codec intended to provide equivalent calls and functionality, without actually serializing/deserializing as JSON 2 | // This is a useful facility for in-memory stores such as Equinox's MemoryStore as it enables you to 3 | // - efficiently test behaviors from an event sourced decision processing perspective (e.g. with Property Based Tests) 4 | // - without paying a serialization cost and/or having to deal with sanitization of generated data in order to make it roundtrippable through same 5 | namespace FsCodec.Box 6 | 7 | open System 8 | open System.Runtime.InteropServices 9 | 10 | /// Provides Codecs that render to boxed object, ideal for usage in a Memory Store. 11 | /// Requires that Contract types adhere to the conventions implied by using TypeShape.UnionContract.UnionContractEncoder
12 | /// If you need full control and/or have have your own codecs, see FsCodec.Codec.Create instead.
13 | /// See for example usage. 14 | [] 15 | type Codec private () = 16 | 17 | static let defEncoder: TypeShape.UnionContract.IEncoder = TypeShape.UnionContract.BoxEncoder() :> _ 18 | 19 | /// Generate an IEventCodec that handles obj (boxed .NET Object) Event Bodies.
20 | /// Uses up, down functions to handle upconversion/downconversion and eventId/correlationId/causationId mapping 21 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event
22 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 23 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 24 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 25 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 26 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 27 | up: Func, 'Contract, 'Event>, 28 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract
29 | // The function is also expected to derive an optional meta object that will be serialized with the same encoder, 30 | // and eventId, correlationId, causationId and an Event Creationtimestamp. 31 | down: Func<'Context, 'Event, struct ('Contract * 'Meta voption * Guid * string * string * DateTimeOffset)>, 32 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 33 | [] ?rejectNullaryCases) 34 | : FsCodec.IEventCodec<'Event, obj, 'Context> = 35 | FsCodec.Core.Codec.Create(defEncoder, up, down, ?rejectNullaryCases = rejectNullaryCases) 36 | 37 | /// Generate an IEventCodec that handles obj (boxed .NET Object) Event Bodies.
38 | /// Uses up, down and mapCausation functions to facilitate upconversion/downconversion and eventId/correlationId/causationId/timestamp mapping 39 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 40 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 41 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 42 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 43 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 44 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 45 | up: Func, 'Contract, 'Event>, 46 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 47 | // The function is also expected to derive 48 | // a meta object that will be serialized with the same options (if it's not None) 49 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 50 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 51 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to a) the final metadata b) the eventId c) the correlationId and d) the causationId 52 | mapCausation: Func<'Context, 'Meta voption, struct ('Meta voption * Guid * string * string)>, 53 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 54 | [] ?rejectNullaryCases) 55 | : FsCodec.IEventCodec<'Event, obj, 'Context> = 56 | FsCodec.Core.Codec.Create(defEncoder, up, down, mapCausation, ?rejectNullaryCases = rejectNullaryCases) 57 | 58 | /// Generate an IEventCodec that handles obj (boxed .NET Object) Event Bodies.
59 | /// Uses up and down functions to facilitate upconversion/downconversion/timestamping without eventId/correlation/causationId mapping 60 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 61 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 62 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 63 | static member Create<'Event, 'Contract, 'Meta when 'Contract :> TypeShape.UnionContract.IUnionContract> 64 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 65 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 66 | up: Func, 'Contract, 'Event>, 67 | // Maps a fresh 'Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 68 | // The function is also expected to derive 69 | // a meta object that will be serialized with the same options (if it's not None) 70 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 71 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 72 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 73 | [] ?rejectNullaryCases) 74 | : FsCodec.IEventCodec<'Event, obj, unit> = 75 | FsCodec.Core.Codec.Create(defEncoder, up, down, ?rejectNullaryCases = rejectNullaryCases) 76 | 77 | /// Generate an IEventCodec that handles obj (boxed .NET Object) Event Bodies.
78 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 79 | /// 'Union must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 80 | static member Create<'Union when 'Union :> TypeShape.UnionContract.IUnionContract> 81 | ( // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 82 | [] ?rejectNullaryCases) 83 | : FsCodec.IEventCodec<'Union, obj, unit> = 84 | FsCodec.Core.Codec.Create(defEncoder, ?rejectNullaryCases = rejectNullaryCases) 85 | -------------------------------------------------------------------------------- /src/FsCodec.Box/Compression.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec 2 | 3 | open System 4 | open System.Runtime.CompilerServices 5 | open System.Runtime.InteropServices 6 | 7 | type [] CompressionOptions = { minSize: int; minGain: int } with 8 | static member Default = { minSize = 48; minGain = 4 } 9 | static member Uncompressed = { minSize = Int32.MaxValue; minGain = 0 } 10 | 11 | [] 12 | type Compression private () = 13 | 14 | static member Utf8ToEncodedDirect(x: ReadOnlyMemory): Encoded = 15 | FsCodec.Encoding.OfBlob x 16 | static member Utf8ToEncodedTryCompress(options, x: ReadOnlyMemory): Encoded = 17 | FsCodec.Encoding.OfBlobCompress({ minSize = options.minSize; minGain = options.minGain }, x) 18 | static member EncodedToUtf8(x: Encoded): ReadOnlyMemory = 19 | FsCodec.Encoding.ToBlob x 20 | /// NOTE if this is for use with System.Text.Encoding.UTF8.GetString, then EncodedToUtf8 >> _.Span is more efficient 21 | static member EncodedToByteArray(x: Encoded): byte[] = 22 | FsCodec.Encoding.ToBlob(x).ToArray() 23 | 24 | /// Adapts an IEventCodec rendering to ReadOnlyMemory<byte> Event Bodies to attempt to compress the data.
25 | /// If sufficient compression, as defined by options is not achieved, the body is saved as-is.
26 | /// The int conveys a value that must be round tripped alongside the body in order for the decoding process to correctly interpret it. 27 | [] 28 | static member EncodeTryCompress<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>, [] ?options) 29 | : IEventCodec<'Event, Encoded, 'Context> = 30 | let opts = defaultArg options CompressionOptions.Default 31 | let opts: FsCodec.CompressionOptions = { minSize = opts.minSize; minGain = opts.minGain } 32 | FsCodec.Core.EventCodec.mapBodies (fun d -> Encoding.OfBlobCompress(opts, d)) Encoding.ToBlob native 33 | 34 | /// Adapts an IEventCodec rendering to ReadOnlyMemory<byte> Event Bodies to encode as per EncodeTryCompress, but without attempting compression. 35 | [] 36 | static member EncodeUncompressed<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>) 37 | : IEventCodec<'Event, Encoded, 'Context> = 38 | Encoder.Uncompressed native 39 | 40 | /// Adapts an IEventCodec rendering to int * ReadOnlyMemory<byte> Event Bodies to render and/or consume from Uncompressed ReadOnlyMemory<byte>. 41 | [] 42 | static member ToUtf8Codec<'Event, 'Context>(native: IEventCodec<'Event, Encoded, 'Context>) 43 | : IEventCodec<'Event, ReadOnlyMemory, 'Context> = 44 | Encoder.AsBlob native 45 | 46 | /// Adapts an IEventCodec rendering to int * ReadOnlyMemory<byte> Event Bodies to render and/or consume from Uncompressed byte[]. 47 | [] 48 | static member ToByteArrayCodec<'Event, 'Context>(native: IEventCodec<'Event, Encoded, 'Context>) 49 | : IEventCodec<'Event, byte[], 'Context> = 50 | Encoder.AsByteArray native 51 | -------------------------------------------------------------------------------- /src/FsCodec.Box/CoreCodec.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.Core 2 | 3 | open System 4 | open System.Runtime.InteropServices 5 | 6 | /// Low-level Codec Generator that encodes to a Generic Event 'Body Type. 7 | /// Requires that Contract types adhere to the conventions implied by using TypeShape.UnionContract.UnionContractEncoder
8 | /// If you need full control and/or have have your own codecs, see FsCodec.Codec.Create instead.
9 | /// See non-Core namespace for application level encoders. 10 | [] 11 | type Codec private () = 12 | 13 | /// Generate an IEventCodec using the supplied encoder.
14 | /// Uses up, down functions to handle upconversion/downconversion and eventId/correlationId/causationId mapping 15 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event
16 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 17 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 18 | static member Create<'Event, 'Contract, 'Meta, 'Body, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 19 | ( encoder, 20 | // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 21 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 22 | up: Func, 'Contract, 'Event>, 23 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract
24 | // The function is also expected to derive an optional meta object that will be serialized with the same encoder, 25 | // and eventId, correlationId, causationId and an Event Creationtimestamp. 26 | down: Func<'Context, 'Event, struct ('Contract * 'Meta voption * Guid * string * string * DateTimeOffset)>, 27 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 28 | [] ?rejectNullaryCases) 29 | : FsCodec.IEventCodec<'Event, 'Body, 'Context> = 30 | 31 | let dataCodec = 32 | TypeShape.UnionContract.UnionContractEncoder.Create<'Contract, 'Body>( 33 | encoder, 34 | // Round-tripping cases like null and/or empty strings etc involves edge cases that stores, 35 | // FsCodec.NewtonsoftJson.Codec, Interop.fs and InteropTests.fs do not cover, so we disable this 36 | requireRecordFields = true, 37 | allowNullaryCases = not (defaultArg rejectNullaryCases false)) 38 | 39 | { new FsCodec.IEventCodec<'Event, 'Body, 'Context> with 40 | 41 | member _.Encode(context, event) = 42 | let struct (c, meta: 'Meta voption, eventId, correlationId, causationId, timestamp) = down.Invoke(context, event) 43 | let enc = dataCodec.Encode c 44 | let meta' = match meta with ValueSome x -> encoder.Encode<'Meta> x | ValueNone -> Unchecked.defaultof<'Body> 45 | EventData(enc.CaseName, enc.Payload, meta', eventId, correlationId, causationId, timestamp) 46 | 47 | member _.Decode encoded = 48 | match dataCodec.TryDecode { CaseName = encoded.EventType; Payload = encoded.Data } with 49 | | None -> ValueNone 50 | | Some contract -> up.Invoke(encoded, contract) |> ValueSome } 51 | 52 | /// Generate an IEventCodec using the supplied encoder.
53 | /// Uses up, down and mapCausation functions to facilitate upconversion/downconversion and eventId/correlationId/causationId/timestamp mapping 54 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 55 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 56 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 57 | static member Create<'Event, 'Contract, 'Meta, 'Body, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 58 | ( encoder, 59 | // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 60 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 61 | up: Func, 'Contract, 'Event>, 62 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 63 | // The function is also expected to derive 64 | // a meta object that will be serialized with the same options (if it's not None) 65 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 66 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 67 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to produce a) the final metadata b) the eventId c) the correlationId and d) the causationId 68 | mapCausation: Func<'Context, 'Meta voption, struct ('Meta voption * Guid * string * string)>, 69 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 70 | [] ?rejectNullaryCases) 71 | : FsCodec.IEventCodec<'Event, 'Body, 'Context> = 72 | 73 | let down context union = 74 | let struct (c, m, t) = down.Invoke union 75 | let struct (m', eventId, correlationId, causationId) = mapCausation.Invoke(context, m) 76 | struct (c, m', eventId, correlationId, causationId, match t with ValueSome t -> t | ValueNone -> DateTimeOffset.UtcNow) 77 | Codec.Create(encoder, up = up, down = down, ?rejectNullaryCases = rejectNullaryCases) 78 | 79 | /// Generate an IEventCodec using the supplied encoder.
80 | /// Uses up and down functions to facilitate upconversion/downconversion/timestamping without eventId/correlation/causationId mapping 81 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 82 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 83 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 84 | static member Create<'Event, 'Contract, 'Meta, 'Body when 'Contract :> TypeShape.UnionContract.IUnionContract> 85 | ( encoder, 86 | // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 87 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 88 | up: Func, 'Contract, 'Event>, 89 | // Maps a fresh 'Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 90 | // The function is also expected to derive 91 | // a meta object that will be serialized with the same options (if it's not None) 92 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 93 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 94 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 95 | [] ?rejectNullaryCases) 96 | : FsCodec.IEventCodec<'Event, 'Body, unit> = 97 | 98 | let mapCausation () (m: 'Meta voption) = struct (m, Guid.NewGuid(), null, null) 99 | Codec.Create(encoder, up = up, down = down, mapCausation = mapCausation, ?rejectNullaryCases = rejectNullaryCases) 100 | 101 | /// Generate an IEventCodec using the supplied encoder.
102 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 103 | /// 'Union must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 104 | static member Create<'Body, 'Union when 'Union :> TypeShape.UnionContract.IUnionContract> 105 | ( encoder: TypeShape.UnionContract.IEncoder<'Body>, 106 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 107 | [] ?rejectNullaryCases) 108 | : FsCodec.IEventCodec<'Union, 'Body, unit> = 109 | 110 | let up (_e: FsCodec.ITimelineEvent<'Body>) (u: 'Union): 'Union = u 111 | let down (event: 'Union) = struct (event, ValueNone (*Meta*), ValueNone (*Timestamp*)) 112 | Codec.Create(encoder, up = up, down = down, ?rejectNullaryCases = rejectNullaryCases) 113 | -------------------------------------------------------------------------------- /src/FsCodec.Box/FsCodec.Box.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | netstandard2.1 7 | 3.0.0 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/Codec.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson.Core 2 | 3 | /// Newtonsoft.Json implementation of TypeShape.UnionContractEncoder's IEncoder that encodes direct to a UTF-8 ReadOnlyMemory 4 | type ReadOnlyMemoryEncoder(serdes: FsCodec.NewtonsoftJson.Serdes) = 5 | interface TypeShape.UnionContract.IEncoder> with 6 | member _.Empty = System.ReadOnlyMemory.Empty 7 | member _.Encode(value: 'T) = serdes.SerializeToUtf8(value) |> System.ReadOnlyMemory 8 | member _.Decode(utf8json: System.ReadOnlyMemory): 'T = serdes.Deserialize<'T>(utf8json) 9 | 10 | namespace FsCodec.NewtonsoftJson 11 | 12 | open Newtonsoft.Json 13 | open System 14 | open System.Runtime.InteropServices 15 | 16 | /// Provides Codecs that render to a ReadOnlyMemory<byte>, suitable for storage in Event Stores that handle Event Data and Metadata as opaque blobs. 17 | /// Requires that Contract types adhere to the conventions implied by using TypeShape.UnionContract.UnionContractEncoder
18 | /// If you need full control and/or have have your own codecs, see FsCodec.Codec.Create instead.
19 | /// See for example usage. 20 | [] 21 | type Codec private () = 22 | 23 | static let defEncoder: Lazy>> = lazy (Core.ReadOnlyMemoryEncoder Serdes.Default :> _) 24 | static let mkEncoder: Serdes option * JsonSerializerSettings option -> TypeShape.UnionContract.IEncoder> = function 25 | | None, None -> defEncoder.Value 26 | | Some serdes, None -> Core.ReadOnlyMemoryEncoder(serdes) 27 | | _, Some opts -> Core.ReadOnlyMemoryEncoder(Serdes opts) 28 | 29 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied Newtonsoft.Json.JsonSerializerSettings options.
30 | /// Uses up, down functions to handle upconversion/downconversion and eventId/correlationId/causationId mapping 31 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event
32 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 33 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 34 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 35 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 36 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 37 | up: Func>, 'Contract, 'Event>, 38 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract
39 | // The function is also expected to derive an optional meta object that will be serialized with the same encoder, 40 | // and eventId, correlationId, causationId and an Event Creationtimestamp. 41 | down: Func<'Context, 'Event, struct ('Contract * 'Meta voption * Guid * string * string * DateTimeOffset)>, 42 | // Configuration to be used by the underlying Newtonsoft.Json Serializer when encoding/decoding. Defaults to same as Options.Default 43 | [] ?options, [] ?serdes, 44 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 45 | [] ?rejectNullaryCases) 46 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context> = 47 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 48 | 49 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied Newtonsoft.Json.JsonSerializerSettings options.
50 | /// Uses up, down and mapCausation functions to facilitate upconversion/downconversion and eventId/correlationId/causationId/timestamp mapping 51 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 52 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 53 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 54 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 55 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 56 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 57 | up: Func>, 'Contract, 'Event>, 58 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 59 | // The function is also expected to derive 60 | // a meta object that will be serialized with the same options (if it's not None) 61 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 62 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 63 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to a) the final metadata b) the eventId c) the correlationId and d) the causationId 64 | mapCausation: Func<'Context, 'Meta voption, struct ('Meta voption * Guid * string * string)>, 65 | // Configuration to be used by the underlying Newtonsoft.Json Serializer when encoding/decoding. Defaults to same as Options.Default 66 | [] ?options, [] ?serdes, 67 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 68 | [] ?rejectNullaryCases) 69 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context> = 70 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, mapCausation, ?rejectNullaryCases = rejectNullaryCases) 71 | 72 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied Newtonsoft.Json.JsonSerializerSettings options.
73 | /// Uses up and down functions to facilitate upconversion/downconversion/timestamping without eventId/correlation/causationId mapping 74 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 75 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 76 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 77 | static member Create<'Event, 'Contract, 'Meta when 'Contract :> TypeShape.UnionContract.IUnionContract> 78 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 79 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 80 | up: Func>, 'Contract, 'Event>, 81 | // Maps a fresh 'Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 82 | // The function is also expected to derive 83 | // a meta object that will be serialized with the same options (if it's not None) 84 | // and an Event Creation timestamp. 85 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 86 | // Configuration to be used by the underlying Newtonsoft.Json Serializer when encoding/decoding. Defaults to same as Options.Default 87 | [] ?options, [] ?serdes, 88 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 89 | [] ?rejectNullaryCases) 90 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, unit> = 91 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 92 | 93 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied Newtonsoft.Json.JsonSerializerSettings options.
94 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 95 | /// 'Union must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 96 | static member Create<'Union when 'Union :> TypeShape.UnionContract.IUnionContract> 97 | ( // Configuration to be used by the underlying Newtonsoft.Json Serializer when encoding/decoding. Defaults to same as Options.Default 98 | [] ?options, [] ?serdes, 99 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 100 | [] ?rejectNullaryCases) 101 | : FsCodec.IEventCodec<'Union, ReadOnlyMemory, unit> = 102 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), ?rejectNullaryCases = rejectNullaryCases) 103 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/FsCodec.NewtonsoftJson.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | netstandard2.1 6 | 3.0.0 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/OptionConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open System 5 | 6 | /// For Some 1 generates "1", for None generates "null" 7 | type OptionConverter() = 8 | inherit JsonConverter() 9 | 10 | override _.CanConvert(t: Type) = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> 11 | 12 | override _.WriteJson(writer: JsonWriter, value: obj, serializer: JsonSerializer) = 13 | let value = 14 | if value = null then null 15 | else 16 | let case = let t = value.GetType() in (FsCodec.Union.Info.get t).getCase value 17 | case.deconstruct value |> Array.exactlyOne 18 | 19 | serializer.Serialize(writer, value) 20 | 21 | override _.ReadJson(reader: JsonReader, t: Type, _existingValue: obj, serializer: JsonSerializer) = 22 | let innerType = 23 | let innerType = t.GetGenericArguments().[0] 24 | if innerType.IsValueType then typedefof>.MakeGenericType(innerType) 25 | else innerType 26 | 27 | let u = FsCodec.Union.Info.get t 28 | let inline none () = u.cases[0].construct Array.empty 29 | if reader.TokenType = JsonToken.Null then 30 | none () 31 | else 32 | let value = serializer.Deserialize(reader, innerType) 33 | if value = null then none () 34 | else u.cases[1].construct (Array.singleton value) 35 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/Options.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open Newtonsoft.Json.Serialization 5 | open System 6 | open System.Runtime.InteropServices 7 | 8 | [] 9 | type Options private () = 10 | 11 | /// Analogous to System.Text.Json's JsonSerializerOptions.Default - allows for sharing/caching of the default profile as defined by Options.Create() 12 | static member val Default: JsonSerializerSettings = Options.Create() 13 | 14 | /// Creates a default set of serializer settings used by Json serialization. When used with no args, same as JsonSerializerSettings.CreateDefault() 15 | /// With one difference - it inhibits the JSON.NET out of the box parsing of strings that look like dates (see https://github.com/JamesNK/Newtonsoft.Json/issues/862) 16 | static member CreateDefault 17 | ( [] converters: JsonConverter[], 18 | // Use multi-line, indented formatting when serializing JSON; defaults to false. 19 | [] ?indent: bool, 20 | // Render idiomatic camelCase for PascalCase items by using `CamelCasePropertyNamesContractResolver`. Defaults to false. 21 | [] ?camelCase: bool, 22 | // Ignore null values in input data; defaults to false. 23 | [] ?ignoreNulls: bool, 24 | // Error on missing values (as opposed to letting them just be default-initialized); defaults to false. 25 | [] ?errorOnMissing: bool) = 26 | let indent = defaultArg indent false 27 | let camelCase = defaultArg camelCase false 28 | let ignoreNulls = defaultArg ignoreNulls false 29 | let errorOnMissing = defaultArg errorOnMissing false 30 | JsonSerializerSettings( 31 | ContractResolver = (if camelCase then CamelCasePropertyNamesContractResolver() : IContractResolver else DefaultContractResolver()), 32 | Converters = converters, 33 | DateTimeZoneHandling = DateTimeZoneHandling.Utc, // Override default of RoundtripKind 34 | DateParseHandling = DateParseHandling.None, // Override hare-brained default of DateTime per https://github.com/JamesNK/Newtonsoft.Json/issues/862 35 | Formatting = (if indent then Formatting.Indented else Formatting.None), 36 | MissingMemberHandling = (if errorOnMissing then MissingMemberHandling.Error else MissingMemberHandling.Ignore), 37 | NullValueHandling = (if ignoreNulls then NullValueHandling.Ignore else NullValueHandling.Include)) 38 | 39 | /// Opinionated helper that creates serializer settings that provide good defaults for F# 40 | /// - no camel case conversion - assumption is you'll use records with camelCased names 41 | /// - Always prepends an OptionConverter() to any converters supplied 42 | /// - everything else is as per CreateDefault:- i.e. emit nulls instead of omitting fields etc 43 | static member Create 44 | ( // List of converters to apply. An implicit OptionConverter() will be prepended and/or be used as a default 45 | [] converters: JsonConverter[], 46 | // Use multi-line, indented formatting when serializing JSON; defaults to false. 47 | [] ?indent: bool, 48 | // Render idiomatic camelCase for PascalCase items by using `CamelCasePropertyNamesContractResolver`. 49 | // Defaults to false on basis that you'll use record and tuple field names that are camelCase (and hence not `CLSCompliant`). 50 | [] ?camelCase: bool, 51 | // Ignore null values in input data; defaults to `false`. 52 | [] ?ignoreNulls: bool, 53 | // Error on missing values (as opposed to letting them just be default-initialized); defaults to false 54 | [] ?errorOnMissing: bool) = 55 | Options.CreateDefault( 56 | converters = [| OptionConverter() 57 | match converters with null -> () | xs -> yield! xs |], 58 | ?ignoreNulls = ignoreNulls, 59 | ?errorOnMissing = errorOnMissing, 60 | ?indent = indent, 61 | ?camelCase = camelCase) 62 | 63 | [] 64 | type StringEnumConverter private () = 65 | 66 | /// Creates a StringEnumConverter.
67 | /// camelCase option defaults to false.
68 | /// allowIntegerValues defaults to false. NOTE: Newtonsoft.Json default is: true. 69 | static member Create(?camelCase, ?allowIntegerValues) = 70 | let allowIntegers = defaultArg allowIntegerValues false 71 | if defaultArg camelCase false then Converters.StringEnumConverter(CamelCaseNamingStrategy(), allowIntegerValues = allowIntegers) 72 | else Converters.StringEnumConverter(AllowIntegerValues = allowIntegers) 73 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/Pickler.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | 5 | [] 6 | type JsonPickler<'T>() = 7 | inherit JsonConverter() 8 | 9 | abstract Write: writer: JsonWriter * serializer: JsonSerializer * source: 'T -> unit 10 | abstract Read: reader: JsonReader * serializer: JsonSerializer -> 'T 11 | 12 | override _.CanConvert t = t = typeof<'T> 13 | override _.CanRead = true 14 | override _.CanWrite = true 15 | 16 | override x.WriteJson(writer: JsonWriter, value: obj, serializer: JsonSerializer) = 17 | x.Write(writer, serializer, value :?> 'T) 18 | override x.ReadJson(reader: JsonReader, _objectType, _existingValue: obj, serializer: JsonSerializer) = 19 | x.Read(reader, serializer) :> obj 20 | 21 | /// Json Converter that serializes based on an isomorphic type 22 | [] 23 | type JsonIsomorphism<'T, 'U>(?targetPickler: JsonPickler<'U>) = 24 | inherit JsonPickler<'T>() 25 | 26 | abstract Pickle: 'T -> 'U 27 | abstract UnPickle: 'U -> 'T 28 | 29 | override x.Write(writer: JsonWriter, serializer: JsonSerializer, source: 'T) = 30 | let target = x.Pickle source 31 | match targetPickler with 32 | | None -> serializer.Serialize(writer, target, typeof<'U>) 33 | | Some p -> p.Write(writer, serializer, target) 34 | override x.Read(reader: JsonReader, serializer: JsonSerializer) = 35 | let target = 36 | match targetPickler with 37 | | None -> serializer.Deserialize<'U>(reader) 38 | | Some p -> p.Read(reader, serializer) 39 | x.UnPickle target 40 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/Serdes.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open System 5 | open System.IO 6 | 7 | /// Reuse interim buffers when coding/encoding 8 | // https://stackoverflow.com/questions/55812343/newtonsoft-json-net-jsontextreader-garbage-collector-intensive 9 | module private CharBuffersPool = 10 | let private inner = System.Buffers.ArrayPool.Shared 11 | let instance = 12 | { new IArrayPool with 13 | member _.Rent minLen = inner.Rent minLen 14 | member _.Return x = inner.Return x } 15 | 16 | // http://www.philosophicalgeek.com/2015/02/06/announcing-microsoft-io-recycablememorystream/ 17 | module private Utf8BytesEncoder = 18 | let private streamManager = Microsoft.IO.RecyclableMemoryStreamManager() 19 | // NOTE GetStream return type changes from MemoryStream to RecyclableMemoryStream in V2-V3 20 | let rentStream (): MemoryStream = streamManager.GetStream("bytesEncoder") 21 | let wrapAsStream (utf8json: ReadOnlyMemory) = 22 | // This is the most efficient way of approaching this without using Spans etc. 23 | // RecyclableMemoryStreamManager does not have any wins to provide us 24 | new MemoryStream(utf8json.ToArray(), writable = false) 25 | let makeJsonReader(ms: MemoryStream) = 26 | new JsonTextReader(new StreamReader(ms), ArrayPool = CharBuffersPool.instance) 27 | let private utf8NoBom = System.Text.UTF8Encoding(false, true) 28 | let makeJsonWriter ms = 29 | // We need to `leaveOpen` in order to allow .Dispose of the `.rentStream`'d to return it 30 | let sw = new StreamWriter(ms, utf8NoBom, 1024, leaveOpen = true) // same middle args as StreamWriter default ctor 31 | new JsonTextWriter(sw, ArrayPool = CharBuffersPool.instance) 32 | 33 | /// Serializes to/from strings using the supplied JsonSerializerSettings 34 | type Serdes(options: JsonSerializerSettings) = 35 | 36 | // Cache serializer instance to avoid JsonConvert helpers creating one per call; see 37 | // https://github.com/JamesNK/Newtonsoft.Json/blob/4dc9af66e07dea321ad101bfb379326127251a80/Src/Newtonsoft.Json/JsonConvert.cs#L817 38 | let serializer = JsonSerializer.Create(options) 39 | 40 | static let def = lazy Serdes Options.Default 41 | /// Cached shortcut for Serdes Options.Default 42 | static member Default: Serdes = def.Value 43 | 44 | /// The JsonSerializerSettings used by this instance. 45 | member _.Options: JsonSerializerSettings = options 46 | 47 | /// Serializes given value to a JSON string. 48 | member _.Serialize<'T>(value: 'T): string = 49 | use sw = new StringWriter(System.Globalization.CultureInfo.InvariantCulture) 50 | use writer = new JsonTextWriter(sw) 51 | serializer.Serialize(writer, value) 52 | sw.ToString() 53 | 54 | /// Serializes given value to a Byte Array, suitable for wrapping as a ReadOnlyMemory. 55 | member _.SerializeToUtf8(value: 'T): byte[] = 56 | use ms = Utf8BytesEncoder.rentStream () 57 | ( use jsonWriter = Utf8BytesEncoder.makeJsonWriter ms 58 | serializer.Serialize(jsonWriter, value, typeof<'T>)) 59 | // TOCONSIDER as noted in the comments on RecyclableMemoryStream.ToArray, ideally we'd be continuing the rental and passing out a Span 60 | ms.ToArray() 61 | 62 | /// Serializes and writes given value to a stream. 63 | member _.SerializeToStream<'T>(value: 'T, utf8Stream: Stream) = 64 | // We're setting CloseOutput = false, because that's the default behavior in STJ 65 | // but also mostly because it's rude to close without asking 66 | use streamWriter = new StreamWriter(utf8Stream, System.Text.Encoding.UTF8, 128, leaveOpen = true) 67 | use writer = new JsonTextWriter(streamWriter, CloseOutput = false) 68 | serializer.Serialize(writer, value) 69 | streamWriter.Flush() 70 | 71 | /// Deserializes value of given type from JSON string. 72 | member _.Deserialize<'T>(json: string): 'T = 73 | use reader = new JsonTextReader(new StringReader(json)) 74 | serializer.Deserialize<'T>(reader) 75 | 76 | /// Deserializes value of given type from a UTF8 JSON Buffer. 77 | member _.Deserialize<'T>(utf8json: ReadOnlyMemory): 'T = 78 | use ms = Utf8BytesEncoder.wrapAsStream utf8json 79 | use jsonReader = Utf8BytesEncoder.makeJsonReader ms 80 | serializer.Deserialize<'T>(jsonReader) 81 | 82 | /// Deserializes value of given type from a (potentially compressed) Encoded value 83 | member x.Deserialize<'T>(utf8Encoded: FsCodec.Encoded): 'T = 84 | x.Deserialize<'T>(FsCodec.Encoding.ToBlob utf8Encoded) 85 | 86 | /// Deserializes value of given type from a JObject 87 | member _.Deserialize<'T>(parsed: Newtonsoft.Json.Linq.JObject): 'T = 88 | parsed.ToObject(typeof<'T>, serializer) :?> 'T 89 | 90 | /// Deserializes by reading from a stream. 91 | member _.DeserializeFromStream<'T>(utf8Stream: Stream) = 92 | use reader = new JsonTextReader(new StreamReader(utf8Stream, System.Text.Encoding.UTF8)) 93 | serializer.Deserialize<'T>(reader) 94 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/StringIdConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | /// Implements conversion to/from string for a FsCodec.StringId-derived type. 4 | [] 5 | type StringIdConverter<'T when 'T :> FsCodec.StringId<'T> >(parse: string -> 'T) = 6 | inherit JsonIsomorphism<'T, string>() 7 | override _.Pickle value = value.ToString() 8 | override _.UnPickle input = parse input 9 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/TypeSafeEnumConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open System 5 | 6 | /// Maps strings to/from Union cases; refuses to convert for values not in the Union 7 | type TypeSafeEnumConverter() = 8 | inherit JsonConverter() 9 | 10 | override _.CanConvert(t: Type) = 11 | FsCodec.TypeSafeEnum.isTypeSafeEnum t 12 | 13 | override _.WriteJson(writer: JsonWriter, value: obj, _: JsonSerializer) = 14 | let t = value.GetType() 15 | let str = FsCodec.Union.caseNameT t value 16 | writer.WriteValue str 17 | 18 | override _.ReadJson(reader: JsonReader, t: Type, _: obj, _: JsonSerializer) = 19 | if reader.TokenType <> JsonToken.String then 20 | sprintf "Unexpected token when reading TypeSafeEnum: %O" reader.TokenType |> JsonSerializationException |> raise 21 | let str = reader.Value :?> string 22 | FsCodec.TypeSafeEnum.parseT t str 23 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/UnionConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open Newtonsoft.Json.Linq 5 | open System 6 | open System.Reflection 7 | 8 | [] 9 | module private UnionInfo = 10 | 11 | /// Parallels F# behavior wrt how it generates a DU's underlying .NET Type 12 | let inline isInlinedIntoUnionItem (t: Type) = 13 | t = typeof 14 | || t.IsValueType 15 | || t.IsArray 16 | || (t.IsGenericType && let g = t.GetGenericTypeDefinition() in typedefof> = g || g.IsValueType) // Nullable, ValueOption 17 | 18 | let hasConverterCache = System.Collections.Concurrent.ConcurrentDictionary() 19 | let typeHasConverterAttribute (t: Type) = hasConverterCache.GetOrAdd(t, fun t -> t.IsDefined(typeof, ``inherit`` = false)) 20 | let isUnionCache = System.Collections.Concurrent.ConcurrentDictionary() 21 | let typeIsUnionWithConverterAttribute t = isUnionCache.GetOrAdd(t, fun t -> FsCodec.Union.isUnion t && typeHasConverterAttribute t) 22 | 23 | let propTypeRequiresConstruction (propertyType: Type) = 24 | not (isInlinedIntoUnionItem propertyType) 25 | && not (typeHasConverterAttribute propertyType) 26 | 27 | /// Prepare arguments for the Case class ctor based on the kind of case and how F# maps that to a Type 28 | /// and/or whether we need to let json.net step in to convert argument types 29 | let mapTargetCaseArgs (inputJObject: JObject) serializer: PropertyInfo[] -> obj [] = function 30 | | [| singleCaseArg |] when propTypeRequiresConstruction singleCaseArg.PropertyType -> 31 | [| inputJObject.ToObject(singleCaseArg.PropertyType, serializer) |] 32 | | multipleFieldsInCustomCaseType -> 33 | [| for fi in multipleFieldsInCustomCaseType -> 34 | match inputJObject[fi.Name] with 35 | | null when 36 | // Afford converters an opportunity to handle the missing field in the best way I can figure out to signal that 37 | // The specific need being covered (see tests) is to ensure that, even with MissingMemberHandling=Ignore, 38 | // the TypeSafeEnumConverter should reject missing values 39 | // not having this case would go direct to `null` without passing go 40 | typeHasConverterAttribute fi.PropertyType 41 | || serializer.MissingMemberHandling = MissingMemberHandling.Error -> 42 | // NB caller can opt out of erroring by setting NullValueHandling = NullValueHandling.Ignore) 43 | // which renders the following equivalent to the next case 44 | JToken.Parse("null").ToObject(fi.PropertyType, serializer) 45 | | null -> null 46 | | itemValue -> itemValue.ToObject(fi.PropertyType, serializer) |] 47 | 48 | /// Serializes a discriminated union case with a single field that is a 49 | /// record by flattening the record fields to the same level as the discriminator 50 | type UnionConverter private (discriminator: string, ?catchAllCase) = 51 | inherit JsonConverter() 52 | 53 | new() = UnionConverter("case", ?catchAllCase = None) 54 | new(discriminator: string) = UnionConverter(discriminator, ?catchAllCase = None) 55 | new(discriminator: string, catchAllCase: string) = UnionConverter(discriminator, ?catchAllCase = match catchAllCase with null -> None | x -> Some x) 56 | 57 | override _.CanConvert(t: Type) = FsCodec.Union.isUnion t 58 | 59 | override _.WriteJson(writer: JsonWriter, value: obj, serializer: JsonSerializer) = 60 | writer.WriteStartObject() 61 | 62 | writer.WritePropertyName(discriminator) 63 | let case = (FsCodec.Union.Info.get (value.GetType())).getCase value 64 | writer.WriteValue(case.name) 65 | 66 | let fieldValues = case.deconstruct value 67 | match case.fields with 68 | | [| fi |] when not (UnionInfo.typeIsUnionWithConverterAttribute fi.PropertyType) -> 69 | match fieldValues[0] with 70 | | null when serializer.NullValueHandling = NullValueHandling.Ignore -> () 71 | | fv -> 72 | let token = if fv = null then JToken.Parse "null" else JToken.FromObject(fv, serializer) 73 | match token.Type with 74 | | JTokenType.Object -> 75 | // flatten the object properties into the same one as the discriminator 76 | for prop in token.Children() do 77 | prop.WriteTo writer 78 | | _ -> 79 | writer.WritePropertyName(fi.Name) 80 | token.WriteTo writer 81 | | _ -> 82 | for fieldInfo, fieldValue in Seq.zip case.fields fieldValues do 83 | if fieldValue <> null || serializer.NullValueHandling = NullValueHandling.Include then 84 | writer.WritePropertyName(fieldInfo.Name) 85 | serializer.Serialize(writer, fieldValue) 86 | 87 | writer.WriteEndObject() 88 | 89 | override _.ReadJson(reader: JsonReader, t: Type, _: obj, serializer: JsonSerializer) = 90 | let token = JToken.ReadFrom reader 91 | if token.Type <> JTokenType.Object then raise (FormatException(sprintf "Expected object token, got %O" token.Type)) 92 | let inputJObject = token :?> JObject 93 | 94 | let targetCase = 95 | let findCaseNamed x = FsCodec.Union.Info.tryFindCaseWithName (FsCodec.Union.Info.get t) ((=) x) 96 | let inputCaseNameValue = inputJObject[discriminator] |> string 97 | match findCaseNamed inputCaseNameValue, catchAllCase with 98 | | None, None -> 99 | sprintf "No case defined for '%s', and no catchAllCase nominated for '%s' on type '%s'" 100 | inputCaseNameValue typeof.Name t.FullName |> invalidOp 101 | | Some c, _ -> c 102 | | None, Some catchAllCaseName -> 103 | match findCaseNamed catchAllCaseName with 104 | | None -> 105 | sprintf "No case defined for '%s', nominated catchAllCase: '%s' not found in type '%s'" 106 | inputCaseNameValue catchAllCaseName t.FullName |> invalidOp 107 | | Some c -> c 108 | targetCase.construct(UnionInfo.mapTargetCaseArgs inputJObject serializer targetCase.fields) 109 | -------------------------------------------------------------------------------- /src/FsCodec.NewtonsoftJson/VerbatimUtf8Converter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.NewtonsoftJson 2 | 3 | open Newtonsoft.Json 4 | open Newtonsoft.Json.Linq 5 | open System 6 | 7 | /// Manages injecting prepared JSON into the data being submitted to a store such as CosmosDB as-is, on the basis we can trust it to be valid json 8 | type VerbatimUtf8JsonConverter() = 9 | inherit JsonConverter() 10 | 11 | override _.CanConvert t = typeof = t 12 | 13 | override _.WriteJson(writer: JsonWriter, value: obj, serializer: JsonSerializer) = 14 | let array = value :?> byte[] 15 | if array = null || array.Length = 0 then serializer.Serialize(writer, null) 16 | else writer.WriteRawValue(System.Text.Encoding.UTF8.GetString(array)) 17 | 18 | override _.ReadJson(reader: JsonReader, _: Type, _: obj, _: JsonSerializer) = 19 | let token = JToken.Load reader 20 | if token.Type = JTokenType.Null then null 21 | else token |> string |> System.Text.Encoding.UTF8.GetBytes |> box 22 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/Codec.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson.Core 2 | 3 | /// System.Text.Json implementation of TypeShape.UnionContractEncoder's IEncoder that encodes to a ReadOnlyMemory<byte> 4 | type ReadOnlyMemoryEncoder(serdes: FsCodec.SystemTextJson.Serdes) = 5 | interface TypeShape.UnionContract.IEncoder> with 6 | member _.Empty = System.ReadOnlyMemory.Empty 7 | member _.Encode(value: 'T) = serdes.SerializeToUtf8<'t>(value) |> System.ReadOnlyMemory 8 | member _.Decode<'T>(utf8json: System.ReadOnlyMemory) = serdes.Deserialize<'T>(utf8json) 9 | 10 | namespace FsCodec.SystemTextJson 11 | 12 | open System 13 | open System.Runtime.InteropServices 14 | open System.Text.Json 15 | 16 | /// Provides Codecs that render to a ReadOnlyMemory<byte>, suitable for storage in Event Stores that handle Event Data and Metadata as opaque blobs. 17 | /// Requires that Contract types adhere to the conventions implied by using TypeShape.UnionContract.UnionContractEncoder
18 | /// If you need full control and/or have have your own codecs, see FsCodec.Codec.Create instead.
19 | /// See for example usage. 20 | [] 21 | type Codec private () = 22 | 23 | // NOTE Options.Default implies unsafeRelaxedJsonEscaping = true 24 | static let defEncoder: Lazy>> = lazy (Core.ReadOnlyMemoryEncoder Serdes.Default :> _) 25 | static let mkEncoder: Serdes option * JsonSerializerOptions option -> TypeShape.UnionContract.IEncoder> = function 26 | | None, None -> defEncoder.Value 27 | | Some serdes, None -> Core.ReadOnlyMemoryEncoder(serdes) 28 | | _, Some opts -> Core.ReadOnlyMemoryEncoder(Serdes opts) 29 | 30 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied System.Text.Json options.
31 | /// Uses up, down functions to handle up/down conversion and eventId/correlationId/causationId mapping 32 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event
33 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 34 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 35 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 36 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 37 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 38 | up: Func>, 'Contract, 'Event>, 39 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract
40 | // The function is also expected to derive an optional meta object that will be serialized with the same encoder, 41 | // and eventId, correlationId, causationId and an Event Creationtimestamp. 42 | down: Func<'Context, 'Event, struct ('Contract * 'Meta voption * Guid * string * string * DateTimeOffset)>, 43 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default 44 | [] ?options, [] ?serdes, 45 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 46 | [] ?rejectNullaryCases) 47 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context> = 48 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 49 | 50 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied System.Text.Json options.
51 | /// Uses up, down and mapCausation functions to facilitate up/down conversion and eventId/correlationId/causationId/timestamp mapping 52 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 53 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 54 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 55 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 56 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 57 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 58 | up: Func>, 'Contract, 'Event>, 59 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 60 | // The function is also expected to derive 61 | // a meta object that will be serialized with the same options (if it's not None) 62 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 63 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 64 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to a) the final metadata b) the eventId c) the correlationId and d) the causationId 65 | mapCausation: Func<'Context, 'Meta voption, struct ('Meta voption * Guid * string * string)>, 66 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 67 | [] ?options, [] ?serdes, 68 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 69 | [] ?rejectNullaryCases) 70 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context> = 71 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, mapCausation, ?rejectNullaryCases = rejectNullaryCases) 72 | 73 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied System.Text.Json options.
74 | /// Uses up and down functions to facilitate upconversion/downconversion/timestamping without eventId/correlation/causationId mapping 75 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 76 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 77 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 78 | static member Create<'Event, 'Contract, 'Meta when 'Contract :> TypeShape.UnionContract.IUnionContract> 79 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 80 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 81 | up: Func>, 'Contract, 'Event>, 82 | // Maps a fresh 'Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 83 | // The function is also expected to derive 84 | // a meta object that will be serialized with the same options (if it's not None) 85 | // and an Event Creation timestamp. 86 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 87 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 88 | [] ?options, [] ?serdes, 89 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 90 | [] ?rejectNullaryCases) 91 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, unit> = 92 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 93 | 94 | /// Generate an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies using the supplied System.Text.Json options.
95 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 96 | /// 'Union must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 97 | static member Create<'Union when 'Union :> TypeShape.UnionContract.IUnionContract> 98 | ( // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 99 | [] ?options, [] ?serdes, 100 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 101 | [] ?rejectNullaryCases) 102 | : FsCodec.IEventCodec<'Union, ReadOnlyMemory, unit> = 103 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), ?rejectNullaryCases = rejectNullaryCases) 104 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/CodecJsonElement.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson.Core 2 | 3 | /// System.Text.Json implementation of TypeShape.UnionContractEncoder's IEncoder that encodes to a JsonElement 4 | type JsonElementEncoder(serdes: FsCodec.SystemTextJson.Serdes) = 5 | interface TypeShape.UnionContract.IEncoder with 6 | member _.Empty = Unchecked.defaultof 7 | member _.Encode(value: 'T) = serdes.SerializeToElement(value) 8 | member _.Decode<'T>(json: System.Text.Json.JsonElement): 'T = serdes.Deserialize<'T>(json) 9 | 10 | namespace FsCodec.SystemTextJson 11 | 12 | open System 13 | open System.Runtime.InteropServices 14 | open System.Text.Json 15 | 16 | /// Provides Codecs that render to a JsonElement suitable for storage in Event Stores that use System.Text.Json internally such as Equinox.CosmosStore v4 and later. 17 | /// Requires that Contract types adhere to the conventions implied by using TypeShape.UnionContract.UnionContractEncoder
18 | /// If you need full control and/or have have your own codecs, see FsCodec.Codec.Create instead.
19 | /// See for example usage. 20 | [] 21 | type CodecJsonElement private () = 22 | 23 | // NOTE Options.Default implies unsafeRelaxedJsonEscaping = true 24 | static let defEncoder: Lazy> = lazy (Core.JsonElementEncoder Serdes.Default :> _) 25 | static let mkEncoder: Serdes option * JsonSerializerOptions option -> TypeShape.UnionContract.IEncoder = function 26 | | None, None -> defEncoder.Value 27 | | Some serdes, None -> Core.JsonElementEncoder(serdes) 28 | | _, Some opts -> Core.JsonElementEncoder(Serdes opts) 29 | 30 | /// Generate an IEventCodec that handles JsonElement Event Bodies using the supplied System.Text.Json options. 31 | /// Uses up, down functions to handle upconversion/downconversion and eventId/correlationId/causationId mapping 32 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event
33 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 34 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 35 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 36 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 37 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 38 | up: Func, 'Contract, 'Event>, 39 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract
40 | // The function is also expected to derive an optional meta object that will be serialized with the same encoder, 41 | // and eventId, correlationId, causationId and an Event Creationtimestamp. 42 | down: Func<'Context, 'Event, struct ('Contract * 'Meta voption * Guid * string * string * DateTimeOffset)>, 43 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default 44 | [] ?options, [] ?serdes, 45 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 46 | [] ?rejectNullaryCases) 47 | : FsCodec.IEventCodec<'Event, JsonElement, 'Context> = 48 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 49 | 50 | /// Generate an IEventCodec that handles JsonElement Event Bodies using the supplied System.Text.Json options. 51 | /// Uses up, down and mapCausation functions to facilitate upconversion/downconversion and eventId/correlationId/causationId/timestamp mapping 52 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 53 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name; 54 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 55 | static member Create<'Event, 'Contract, 'Meta, 'Context when 'Contract :> TypeShape.UnionContract.IUnionContract> 56 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 57 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 58 | up: Func, 'Contract, 'Event>, 59 | // Maps a fresh Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 60 | // The function is also expected to derive 61 | // a meta object that will be serialized with the same options (if it's not None) 62 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 63 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 64 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to a) the final metadata b) the eventId c) the correlationId and d) the causationId 65 | mapCausation: Func<'Context, 'Meta voption, struct ('Meta voption * Guid * string * string)>, 66 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 67 | [] ?options, [] ?serdes, 68 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 69 | [] ?rejectNullaryCases) 70 | : FsCodec.IEventCodec<'Event, JsonElement, 'Context> = 71 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, mapCausation, ?rejectNullaryCases = rejectNullaryCases) 72 | 73 | /// Generate an IEventCodec that handles JsonElement Event Bodies using the supplied System.Text.Json options. 74 | /// Uses up and down functions to facilitate upconversion/downconversion/timestamping without eventId/correlation/causationId mapping 75 | /// and/or surfacing metadata to the programming model by including it in the emitted 'Event 76 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 77 | /// Contract must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 78 | static member Create<'Event, 'Contract, 'Meta when 'Contract :> TypeShape.UnionContract.IUnionContract> 79 | ( // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 80 | // to the representation (typically a Discriminated Union) that is to be presented to the programming model. 81 | up: Func, 'Contract, 'Event>, 82 | // Maps a fresh 'Event resulting from a Decision in the Domain representation type down to the TypeShape UnionConverter 'Contract 83 | // The function is also expected to derive 84 | // a meta object that will be serialized with the same options (if it's not None) 85 | // and an Event Creation timestamp. 86 | down: Func<'Event, struct ('Contract * 'Meta voption * DateTimeOffset voption)>, 87 | // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 88 | [] ?options, [] ?serdes, 89 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 90 | [] ?rejectNullaryCases) 91 | : FsCodec.IEventCodec<'Event, JsonElement, unit> = 92 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), up, down, ?rejectNullaryCases = rejectNullaryCases) 93 | 94 | /// Generate an IEventCodec that handles JsonElement Event Bodies using the supplied System.Text.Json options. 95 | /// The Event Type Names are inferred based on either explicit DataMember(Name= Attributes, or (if unspecified) the Discriminated Union Case Name 96 | /// 'Union must be tagged with interface TypeShape.UnionContract.IUnionContract to signify this scheme applies. 97 | static member Create<'Union when 'Union :> TypeShape.UnionContract.IUnionContract> 98 | ( // Configuration to be used by the underlying System.Text.Json Serializer when encoding/decoding. Defaults to same as Options.Default. 99 | [] ?options, [] ?serdes, 100 | // Enables one to fail encoder generation if union contains nullary cases. Defaults to false, i.e. permitting them. 101 | [] ?rejectNullaryCases) 102 | : FsCodec.IEventCodec<'Union, JsonElement, unit> = 103 | FsCodec.Core.Codec.Create(mkEncoder (serdes, options), ?rejectNullaryCases = rejectNullaryCases) 104 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | netstandard2.1 7 | 3.0.0 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/Interop.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson.Interop 2 | 3 | open System 4 | open System.Runtime.CompilerServices 5 | open System.Text.Json 6 | 7 | [] 8 | type InteropHelpers private () = 9 | 10 | static member Utf8ToJsonElement(x: ReadOnlyMemory): JsonElement = 11 | if x.IsEmpty then JsonElement() 12 | else JsonSerializer.Deserialize(x.Span) 13 | 14 | static member JsonElementToUtf8(x: JsonElement): ReadOnlyMemory = 15 | if x.ValueKind = JsonValueKind.Undefined then ReadOnlyMemory.Empty 16 | // Avoid introduction of HTML escaping for things like quotes etc (Options.Default uses Options.Create(), which defaults to unsafeRelaxedJsonEscaping = true) 17 | else JsonSerializer.SerializeToUtf8Bytes(x, options = FsCodec.SystemTextJson.Options.Default) |> ReadOnlyMemory 18 | 19 | /// Adapts an IEventCodec that's rendering to JsonElement Event Bodies to handle ReadOnlyMemory<byte> bodies instead.
20 | /// NOTE where possible, it's better to use Codec in preference to CodecJsonElement to encode directly in order to avoid this mapping process. 21 | [] 22 | static member ToUtf8Codec<'Event, 'Context>(native: FsCodec.IEventCodec<'Event, JsonElement, 'Context>) 23 | : FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context> = 24 | FsCodec.Core.EventCodec.mapBodies InteropHelpers.JsonElementToUtf8 InteropHelpers.Utf8ToJsonElement native 25 | 26 | /// Adapts an IEventCodec that's rendering to ReadOnlyMemory<byte> Event Bodies to handle JsonElement bodies instead.
27 | /// NOTE where possible, it's better to use CodecJsonElement in preference to Codec to encode directly in order to avoid this mapping process. 28 | [] 29 | static member ToJsonElementCodec<'Event, 'Context>(native: FsCodec.IEventCodec<'Event, ReadOnlyMemory, 'Context>) 30 | : FsCodec.IEventCodec<'Event, JsonElement, 'Context> = 31 | FsCodec.Core.EventCodec.mapBodies InteropHelpers.Utf8ToJsonElement InteropHelpers.JsonElementToUtf8 native 32 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/Options.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open System 4 | open System.Runtime.InteropServices 5 | open System.Text.Json 6 | open System.Text.Json.Serialization 7 | 8 | #nowarn "44" // see IgnoreNullValues below 9 | 10 | [] 11 | type Options private () = 12 | 13 | /// Analogous to JsonSerializerOptions.Default - allows for sharing/caching of the default profile as defined by Options.Create() 14 | static member val Default: JsonSerializerOptions = Options.Create() 15 | 16 | /// Creates a default set of serializer options used by Json serialization. When used with no args, same as JsonSerializerOptions() 17 | static member CreateDefault 18 | ( [] converters: JsonConverter[], 19 | // Use multi-line, indented formatting when serializing JSON; defaults to false. 20 | [] ?indent: bool, 21 | // Render idiomatic camelCase for PascalCase items by using `PropertyNamingPolicy`/`DictionaryKeyPolicy = CamelCase`. Defaults to false. 22 | [] ?camelCase: bool, 23 | // Ignore null values in input data, don't render fields with null values; defaults to `false`. 24 | [] ?ignoreNulls: bool, 25 | // Drop escaping of HTML-sensitive characters. defaults to `false`. 26 | [] ?unsafeRelaxedJsonEscaping: bool) = 27 | let indent = defaultArg indent false 28 | let camelCase = defaultArg camelCase false 29 | let ignoreNulls = defaultArg ignoreNulls false 30 | let unsafeRelaxedJsonEscaping = defaultArg unsafeRelaxedJsonEscaping false 31 | 32 | let options = JsonSerializerOptions() 33 | if converters <> null then converters |> Array.iter options.Converters.Add 34 | if indent then options.WriteIndented <- true 35 | if camelCase then options.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase; options.DictionaryKeyPolicy <- JsonNamingPolicy.CamelCase 36 | if ignoreNulls then options.IgnoreNullValues <- true // options.DefaultIgnoreCondition <- JsonIgnoreCondition.Always is outlawed so nowarn required 37 | if unsafeRelaxedJsonEscaping then options.Encoder <- System.Text.Encodings.Web.JavaScriptEncoder.UnsafeRelaxedJsonEscaping 38 | options 39 | 40 | /// Opinionated helper that creates serializer settings that represent good defaults for F#
41 | /// - no camel case conversion - assumption is you'll use records with camelCased names (which is the System.Text.Json default)
42 | /// - renders values with UnsafeRelaxedJsonEscaping - i.e. minimal escaping as per Newtonsoft.Json
43 | /// Everything else is as per CreateDefault, i.e. emit nulls instead of omitting fields, no indenting 44 | static member Create 45 | ( // List of converters to apply. Implicit converters may be prepended and/or be used as a default 46 | [] converters: JsonConverter[], 47 | // Use multi-line, indented formatting when serializing JSON; defaults to false. 48 | [] ?indent: bool, 49 | // Render idiomatic camelCase for PascalCase items by using `PropertyNamingPolicy`/`DictionaryKeyPolicy = CamelCase`. 50 | // As with NewtonsoftJson.Options, defaults to false on basis that you'll use record and tuple field names that are already camelCase. 51 | // NOTE this is also the System.Text.Json default (but Newtonsoft.Json does conversion by default out of the box) 52 | [] ?camelCase: bool, 53 | // Ignore null values in input data, don't render fields with null values; defaults to `false`. 54 | [] ?ignoreNulls: bool, 55 | // Drop escaping of HTML-sensitive characters. Defaults to `true` (NOTE this can represent a security concern). 56 | [] ?unsafeRelaxedJsonEscaping: bool, 57 | // Apply TypeSafeEnumConverter if possible. Defaults to false. 58 | [] ?autoTypeSafeEnumToJsonString: bool, 59 | // Apply UnionConverter for all Discriminated Unions, if TypeSafeEnumConverter not possible. Defaults to false. 60 | [] ?autoUnionToJsonObject: bool, 61 | // Apply RejectNullStringConverter in order to have serialization throw on null strings. 62 | // Use string option to represent strings that can potentially be null. 63 | [] ?rejectNullStrings: bool) = 64 | let autoTypeSafeEnumToJsonString = defaultArg autoTypeSafeEnumToJsonString false 65 | let autoUnionToJsonObject = defaultArg autoUnionToJsonObject false 66 | let rejectNullStrings = defaultArg rejectNullStrings false 67 | 68 | Options.CreateDefault( 69 | converters = [| 70 | if rejectNullStrings then RejectNullStringConverter() 71 | if autoTypeSafeEnumToJsonString || autoUnionToJsonObject then 72 | UnionOrTypeSafeEnumConverterFactory(typeSafeEnum = autoTypeSafeEnumToJsonString, union = autoUnionToJsonObject) 73 | if converters <> null then yield! converters |], 74 | ?ignoreNulls = ignoreNulls, 75 | ?indent = indent, 76 | ?camelCase = camelCase, 77 | unsafeRelaxedJsonEscaping = defaultArg unsafeRelaxedJsonEscaping true) 78 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/Pickler.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open System.Text.Json 4 | 5 | [] 6 | type JsonPickler<'T>() = 7 | inherit Serialization.JsonConverter<'T>() 8 | 9 | abstract Read: reader: byref * options: JsonSerializerOptions -> 'T 10 | 11 | override x.Read(reader, _typeToConvert, options) = 12 | x.Read(&reader, options) 13 | 14 | /// Json Converter that serializes based on an isomorphic type 15 | [] 16 | type JsonIsomorphism<'T, 'U>(?targetPickler: JsonPickler<'U>) = 17 | inherit JsonPickler<'T>() 18 | 19 | abstract Pickle: 'T -> 'U 20 | abstract UnPickle: 'U -> 'T 21 | 22 | override x.Write(writer, source: 'T, options) = 23 | let target = x.Pickle source 24 | match targetPickler with 25 | | None -> JsonSerializer.Serialize(writer, target, options) 26 | | Some p -> p.Write(writer, target, options) 27 | override x.Read(reader, options): 'T = 28 | let target = 29 | match targetPickler with 30 | | None -> JsonSerializer.Deserialize<'U>(&reader, options) 31 | | Some p -> p.Read(&reader, options) 32 | x.UnPickle target 33 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/RejectNullStringConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | type RejectNullStringConverter() = 4 | inherit System.Text.Json.Serialization.JsonConverter() 5 | 6 | let [] message = "Expected string, got null. When allowNullStrings is false you must explicitly type optional strings as 'string option'" 7 | 8 | override _.HandleNull = true 9 | override _.CanConvert t = t = typeof 10 | 11 | override this.Read(reader, _typeToConvert, _options) = 12 | let value = reader.GetString() 13 | if value = null then nullArg message 14 | value 15 | 16 | override this.Write(writer, value, _options) = 17 | if value = null then nullArg message 18 | writer.WriteStringValue(value) 19 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/Serdes.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open System.IO 4 | open System.Text.Json 5 | 6 | /// Serializes to/from strings using the supplied Options 7 | type Serdes(options: JsonSerializerOptions) = 8 | 9 | static let def = lazy Serdes Options.Default 10 | /// Cached shortcut for Serdes Options.Default 11 | static member Default: Serdes = def.Value 12 | 13 | /// The JsonSerializerOptions used by this instance. 14 | member _.Options: JsonSerializerOptions = options 15 | 16 | /// Serializes given value to a JSON string. 17 | member _.Serialize<'T>(value: 'T): string = 18 | JsonSerializer.Serialize<'T>(value, options) 19 | 20 | /// Serializes and writes given value to a stream. 21 | member _.SerializeToElement<'T>(value: 'T): JsonElement = 22 | JsonSerializer.SerializeToElement<'T>(value, options) 23 | 24 | /// Serializes given value to a Byte Array, suitable for wrapping as a ReadOnlyMemory. 25 | /// NOTE: FsCodec.SystemTextJson.Options.Default defaults to unsafeRelaxedJsonEscaping = false 26 | member _.SerializeToUtf8<'T>(value: 'T): byte[] = 27 | JsonSerializer.SerializeToUtf8Bytes(value, options) 28 | 29 | /// Serializes and writes given value to a stream. 30 | /// NOTE: FsCodec.SystemTextJson.Options.Default defaults to unsafeRelaxedJsonEscaping = false. 31 | member _.SerializeToStream<'T>(value: 'T, utf8Stream: Stream): unit = 32 | JsonSerializer.Serialize<'T>(utf8Stream, value, options) 33 | 34 | /// Deserializes value of given type from JSON string. 35 | member _.Deserialize<'T>(json: string): 'T = 36 | JsonSerializer.Deserialize<'T>(json, options) 37 | 38 | /// Deserializes value of given type from a JsonElement. 39 | member _.Deserialize<'T>(e: JsonElement): 'T = 40 | JsonSerializer.Deserialize<'T>(e, options) 41 | 42 | /// Deserializes value of given type from a UTF8 JSON Span. 43 | member _.Deserialize<'T>(span: System.ReadOnlySpan): 'T = 44 | JsonSerializer.Deserialize<'T>(span, options) 45 | 46 | /// Deserializes value of given type from a UTF8 JSON Buffer. 47 | member x.Deserialize<'T>(utf8json: System.ReadOnlyMemory): 'T = 48 | x.Deserialize<'T>(utf8json.Span) 49 | 50 | /// Deserializes value of given type from a (potentially compressed) Encoded JsonElement-based value 51 | member x.Deserialize<'T>(encoded: Encoded): 'T = 52 | x.Deserialize<'T>(Encoding.ToJsonElement encoded) 53 | 54 | /// Deserializes value of given type from a (potentially compressed) Encoded value 55 | member x.Deserialize<'T>(utf8Encoded: FsCodec.Encoded): 'T = 56 | x.Deserialize<'T>(FsCodec.Encoding.ToBlob utf8Encoded) 57 | 58 | /// Deserializes by reading from a stream. 59 | member _.DeserializeFromStream<'T>(utf8Stream: Stream): 'T = 60 | JsonSerializer.Deserialize<'T>(utf8Stream, options) 61 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/StringIdConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | /// Implements conversion to/from string for a FsCodec.StringId-derived type. 4 | [] 5 | type StringIdConverter<'T when 'T :> FsCodec.StringId<'T> >(parse: string -> 'T) = 6 | inherit System.Text.Json.Serialization.JsonConverter<'T>() 7 | override _.Write(writer, value, _options) = value.ToString() |> writer.WriteStringValue 8 | override _.Read(reader, _type, _options) = reader.GetString() |> parse 9 | 10 | /// Implements conversion to/from string for a FsCodec.StringId-derived type.
11 | /// Opts into use of the underlying token as a valid property name when tth type is used as a Key in a IDictionary. 12 | [] 13 | type StringIdOrDictionaryKeyConverter<'T when 'T :> FsCodec.StringId<'T> >(parse: string -> 'T) = 14 | inherit System.Text.Json.Serialization.JsonConverter<'T>() 15 | override _.Write(writer, value, _options) = value.ToString() |> writer.WriteStringValue 16 | override _.WriteAsPropertyName(writer, value, _options) = value.ToString() |> writer.WritePropertyName 17 | override _.Read(reader, _type, _options) = reader.GetString() |> parse 18 | override _.ReadAsPropertyName(reader, _type, _options) = reader.GetString() |> parse 19 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open System.Text.Json 4 | 5 | /// Maps strings to/from Union cases; refuses to convert for values not in the Union 6 | type TypeSafeEnumConverter<'T>() = 7 | inherit Serialization.JsonConverter<'T>() 8 | 9 | override _.CanConvert t = 10 | t = typeof<'T> && FsCodec.Union.isUnion t && FsCodec.Union.isNullary t 11 | 12 | override _.Write(writer, value, _options) = 13 | value |> FsCodec.TypeSafeEnum.toString |> writer.WriteStringValue 14 | 15 | override _.Read(reader, _t, _options) = 16 | if reader.TokenType <> JsonTokenType.String then 17 | sprintf "Unexpected token when reading TypeSafeEnum: %O" reader.TokenType |> JsonException |> raise 18 | reader.GetString() |> FsCodec.TypeSafeEnum.parse<'T> 19 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/UnionConverter.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open FSharp.Reflection 4 | open System 5 | open System.Text.Json 6 | 7 | /// Use this attribute in combination with a JsonConverter / UnionConverter attribute to specify 8 | /// your own name for a discriminator and/or a catch-all case for a specific discriminated union. 9 | /// [<JsonConverter(typeof<UnionConverter<T>>); JsonUnionConverterOptions("type")>] 10 | [] 11 | type JsonUnionConverterOptionsAttribute(discriminator: string) = 12 | inherit Attribute() 13 | member val internal DiscriminatorPropName = discriminator 14 | member val CatchAllCase: string = null with get, set 15 | 16 | module private UnionConverterOptions = 17 | let private defaultOptions = JsonUnionConverterOptionsAttribute("case", CatchAllCase = null) 18 | let get (t: Type) = 19 | match t.GetCustomAttributes(typeof, false) with 20 | | [||] -> defaultOptions 21 | | xs -> Array.exactlyOne xs :?> _ // AttributeUsage(AllowMultiple = false) 22 | 23 | type UnionConverter<'T>() = 24 | inherit Serialization.JsonConverter<'T>() 25 | 26 | let converterOptions = UnionConverterOptions.get typeof<'T> 27 | let info = FsCodec.Union.Info.get typeof<'T> 28 | 29 | override _.CanConvert t = t = typeof<'T> && FsCodec.Union.isUnion t 30 | 31 | override _.Write(writer: Utf8JsonWriter, value, options: JsonSerializerOptions) = 32 | let value = box value 33 | writer.WriteStartObject() 34 | writer.WritePropertyName(converterOptions.DiscriminatorPropName) 35 | let case = info.getCase value 36 | writer.WriteStringValue(case.name) 37 | let fieldValues = case.deconstruct value 38 | for fieldInfo, fieldValue in Seq.zip case.fields fieldValues do 39 | if fieldValue <> null || options.DefaultIgnoreCondition <> Serialization.JsonIgnoreCondition.Always then 40 | let element = JsonSerializer.SerializeToElement(fieldValue, fieldInfo.PropertyType, options) 41 | if case.fields.Length = 1 && FSharpType.IsRecord(fieldInfo.PropertyType, true) then 42 | // flatten the record properties into the same JSON object as the discriminator 43 | for prop in element.EnumerateObject() do 44 | prop.WriteTo writer 45 | else 46 | writer.WritePropertyName(fieldInfo.Name) 47 | element.WriteTo writer 48 | writer.WriteEndObject() 49 | 50 | override _.Read(reader, t: Type, options) = 51 | if reader.TokenType <> JsonTokenType.StartObject then 52 | sprintf "Unexpected token when reading Union: %O" reader.TokenType |> JsonException |> raise 53 | use document = JsonDocument.ParseValue &reader 54 | let element = document.RootElement 55 | 56 | let case = 57 | let inputCaseNameValue = element.GetProperty converterOptions.DiscriminatorPropName |> string 58 | let findCaseNamed x = FsCodec.Union.Info.tryFindCaseWithName info ((=) x) 59 | match findCaseNamed inputCaseNameValue, converterOptions.CatchAllCase with 60 | | None, null -> 61 | sprintf "No case defined for '%s', and no catchAllCase nominated for '%s' on type '%s'" 62 | inputCaseNameValue typeof>.Name t.FullName |> invalidOp 63 | | Some c, _ -> c 64 | | None, catchAllCaseName -> 65 | match findCaseNamed catchAllCaseName with 66 | | None -> 67 | sprintf "No case defined for '%s', nominated catchAllCase: '%s' not found in type '%s'" 68 | inputCaseNameValue catchAllCaseName t.FullName |> invalidOp 69 | | Some c -> c 70 | let ctorArgs = 71 | [| for fieldInfo in case.fields -> 72 | let ft = fieldInfo.PropertyType 73 | let targetEl = 74 | if case.fields.Length = 1 && (ft = typeof || FSharpType.IsRecord(ft, true)) then element 75 | else let _found, el = element.TryGetProperty fieldInfo.Name in el 76 | JsonSerializer.Deserialize(targetEl, ft, options) |] 77 | case.construct ctorArgs :?> 'T 78 | -------------------------------------------------------------------------------- /src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec.SystemTextJson 2 | 3 | open System.Text.Json.Serialization 4 | 5 | type UnionOrTypeSafeEnumConverterFactory(typeSafeEnum, union) = 6 | inherit JsonConverterFactory() 7 | 8 | static let cache = System.Collections.Concurrent.ConcurrentDictionary() 9 | static let typeHasConverterAttribute t: bool = cache.GetOrAdd(t, fun (t: System.Type) -> t.IsDefined(typeof, ``inherit`` = false)) 10 | 11 | override _.CanConvert t = 12 | not (t.IsGenericType && let g = t.GetGenericTypeDefinition() in g = typedefof> || g = typedefof>) 13 | && FsCodec.Union.isUnion t 14 | && not (typeHasConverterAttribute t) 15 | && ((typeSafeEnum && union) 16 | || typeSafeEnum = FsCodec.Union.isNullary t) 17 | 18 | override _.CreateConverter(t, _options) = 19 | let openConverterType = if FsCodec.Union.isNullary t then typedefof> else typedefof> 20 | openConverterType.MakeGenericType(t).GetConstructors().[0].Invoke[||] :?> _ 21 | -------------------------------------------------------------------------------- /src/FsCodec/Codec.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec 2 | 3 | open System 4 | 5 | /// Provides Codecs that render to store-supported form (e.g., a UTF-8 byte array) suitable for storage in Event Stores, based on explicit functions you supply 6 | /// Does not involve conventions / Type Shapes / Reflection or specific Json processing libraries - see FsCodec.*.Codec for batteries-included Coding/Decoding 7 | [] 8 | type Codec = 9 | 10 | /// Generate an IEventCodec suitable using the supplied pair of encode and decode functions. 11 | /// It's recommended to split the encode logic between event and metadata generation by using the overload with the mapCausation 12 | /// function in preference to this low level function, which is intended for low lever store syncing logic, as opposed to application code. 13 | static member Create<'Event, 'Format, 'Context> 14 | ( // Maps an 'Event to: an Event Type Name, a pair of 'Format's representing the Data and Meta together with the 15 | // eventId, correlationId, causationId and timestamp. 16 | encode: Func<'Context, 'Event, struct (string * 'Format * 'Format * Guid * string * string * DateTimeOffset)>, 17 | // Attempts to map from an Event's stored data to Some 'Event, or None if not mappable. 18 | decode: Func, 'Event voption>) 19 | : IEventCodec<'Event, 'Format, 'Context> = 20 | 21 | { new IEventCodec<'Event, 'Format, 'Context> with 22 | member _.Encode(context, event) = 23 | let struct (eventType, data, metadata, eventId, correlationId, causationId, timestamp) = encode.Invoke(context, event) 24 | Core.EventData(eventType, data, metadata, eventId, correlationId, causationId, timestamp) 25 | 26 | member _.Decode encoded = 27 | decode.Invoke encoded } 28 | 29 | /// Generate an IEventCodec suitable using the supplied encode and decode functions to map to/from the stored form. 30 | /// mapCausation provides metadata generation and correlation/causationId mapping based on the context passed to the encoder 31 | static member Create<'Event, 'Format, 'Context> 32 | ( // Maps a fresh 'Event resulting from the Domain representation type down to the TypeShape UnionConverter 'Contract 33 | // The function is also responsible for deriving: 34 | // a meta object that will be serialized with the same settings (if it's not None) 35 | // and an Event Creation timestamp (Default: DateTimeOffset.UtcNow). 36 | encode: Func<'Event, struct (string * 'Format * DateTimeOffset voption)>, 37 | // Maps from the TypeShape UnionConverter 'Contract case the Event has been mapped to (with the raw event data as context) 38 | // to the 'Event representation (typically a Discriminated Union) that is to be presented to the programming model. 39 | decode: Func, 'Event voption>, 40 | // Uses the 'Context passed to the Encode call and the 'Meta emitted by down to a) the final metadata b) the correlationId and c) the correlationId 41 | mapCausation: Func<'Context, 'Event, struct ('Format * Guid * string * string)>) 42 | : IEventCodec<'Event, 'Format, 'Context> = 43 | 44 | let encode context event = 45 | let struct (et, d, t) = encode.Invoke event 46 | let ts = match t with ValueSome x -> x | ValueNone -> DateTimeOffset.UtcNow 47 | let struct (m, eventId, correlationId, causationId) = mapCausation.Invoke(context, event) 48 | struct (et, d, m, eventId, correlationId, causationId, ts) 49 | Codec.Create(encode, decode) 50 | 51 | /// Generate an IEventCodec using the supplied pair of encode and decode functions. 52 | static member Create<'Event, 'Format> 53 | ( // Maps a 'Event to an Event Type Name and an encoded body (to be used as the Data). 54 | encode: Func<'Event, struct (string * 'Format)>, 55 | // Attempts to map an Event Type Name and an encoded Data to Some 'Event case, or None if not mappable. 56 | decode: Func) 57 | : IEventCodec<'Event, 'Format, unit> = 58 | 59 | let encode' _context event = 60 | let struct (eventType, data: 'Format) = encode.Invoke event 61 | struct (eventType, data, Unchecked.defaultof<'Format> (* metadata *), 62 | Guid.NewGuid() (* eventId *), null (* correlationId *), null (* causationId *), DateTimeOffset.UtcNow (* timestamp *)) 63 | let decode' (encoded: ITimelineEvent<'Format>) = decode.Invoke(encoded.EventType, encoded.Data) 64 | Codec.Create(encode', decode') 65 | -------------------------------------------------------------------------------- /src/FsCodec/Encoding.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec 2 | 3 | open System 4 | open System.Runtime.CompilerServices 5 | open System.Runtime.InteropServices 6 | 7 | /// Represents the body of an Event (or its Metadata), holding the encoded form of the buffer together with an enum value signifying the encoding scheme. 8 | /// Enables the decoding side to transparently inflate the data on loading without burdening the application layer with tracking the encoding scheme used 9 | type Encoded = (struct(int * ReadOnlyMemory)) 10 | 11 | module Encoding = 12 | let [] Direct = 0 // Assumed for all values not listed here 13 | let [] Deflate = 1 // Deprecated encoding produced by versions pre 3.0.0-rc.13; no longer produced 14 | let [] Brotli = 2 // Default encoding as of 3.0.0-rc.13 15 | 16 | module private Impl = 17 | 18 | (* Decompression logic: triggered by extension methods below at the point where the Codec's Decode retrieves the Data or Meta properties *) 19 | 20 | // In versions pre 3.0.0-rc.13, the compression was implemented as follows; NOTE: use of Flush vs Close saves space but is unconventional 21 | // let private deflate (eventBody: ReadOnlyMemory): System.IO.MemoryStream = 22 | // let output = new System.IO.MemoryStream() 23 | // let compressor = new System.IO.Compression.DeflateStream(output, System.IO.Compression.CompressionLevel.Optimal, leaveOpen = true) 24 | // compressor.Write(eventBody.Span) 25 | // compressor.Flush() // NOTE: using Flush in lieu of close means the result is not padded, which can hinder interop 26 | // output 27 | let private inflateTo output (data: ReadOnlyMemory) = 28 | let input = new System.IO.MemoryStream(data.ToArray(), writable = false) 29 | let decompressor = new System.IO.Compression.DeflateStream(input, System.IO.Compression.CompressionMode.Decompress, leaveOpen = true) 30 | decompressor.CopyTo output 31 | let private brotliDecompressTo output (data: ReadOnlyMemory) = 32 | let input = new System.IO.MemoryStream(data.ToArray(), writable = false) 33 | use decompressor = new System.IO.Compression.BrotliStream(input, System.IO.Compression.CompressionMode.Decompress) 34 | decompressor.CopyTo output 35 | let private unpack alg compressedBytes = 36 | use output = new System.IO.MemoryStream() 37 | compressedBytes |> alg output 38 | output.ToArray() |> ReadOnlyMemory 39 | let decode struct (encoding, data): ReadOnlyMemory = 40 | match encoding with 41 | | Encoding.Deflate -> data |> unpack inflateTo 42 | | Encoding.Brotli -> data |> unpack brotliDecompressTo 43 | | Encoding.Direct | _ -> data 44 | 45 | (* Conditional compression logic: triggered as storage layer pulls Data/Meta fields 46 | Bodies under specified minimum size, or not meeting a required compression gain are stored directly, equivalent to if compression had not been wired in *) 47 | 48 | let private brotliCompress (eventBody: ReadOnlyMemory): System.IO.MemoryStream = 49 | let output = new System.IO.MemoryStream() 50 | use compressor = new System.IO.Compression.BrotliStream(output, System.IO.Compression.CompressionLevel.Optimal, leaveOpen = true) 51 | compressor.Write(eventBody.Span) 52 | compressor.Close() // NOTE Close, not Flush; we want the output fully terminated to reduce surprises when decompressing 53 | output 54 | let encodeUncompressed (raw: ReadOnlyMemory): Encoded = Encoding.Direct, raw 55 | let tryCompress minSize minGain (raw: ReadOnlyMemory): Encoded = 56 | if raw.Length < minSize then encodeUncompressed raw 57 | else match brotliCompress raw with 58 | | tmp when raw.Length > int tmp.Length + minGain -> Encoding.Brotli, tmp.ToArray() |> ReadOnlyMemory 59 | | _ -> encodeUncompressed raw 60 | 61 | type [] CompressionOptions = { minSize: int; minGain: int } with 62 | /// Attempt to compress anything possible 63 | // TL;DR in general it's worth compressing everything to minimize RU consumption both on insert and update 64 | // For DynamoStore, every time we need to calve from the tip, the RU impact of using TransactWriteItems is significant, 65 | // so preventing or delaying that is of critical importance 66 | // Empirically not much JSON below 48 bytes actually compresses - while we don't assume that, it is what is guiding the derivation of the default 67 | static member Default = { minSize = 48; minGain = 4 } 68 | 69 | [] 70 | type Encoding private () = 71 | 72 | static member OfBlob(x: ReadOnlyMemory): Encoded = 73 | Impl.encodeUncompressed x 74 | static member OfBlobCompress(options, x: ReadOnlyMemory): Encoded = 75 | Impl.tryCompress options.minSize options.minGain x 76 | static member ToBlob(x: Encoded): ReadOnlyMemory = 77 | Impl.decode x 78 | static member GetStringUtf8(x: Encoded): string = 79 | System.Text.Encoding.UTF8.GetString(Encoding.ToBlob(x).Span) 80 | static member ByteCount((_encoding, data): Encoded) = 81 | data.Length 82 | 83 | [] 84 | type Encoder private () = 85 | 86 | /// Adapts an IEventCodec rendering to ReadOnlyMemory<byte> Event Bodies to attempt to compress the data.
87 | /// If sufficient compression, as defined by options is not achieved, the body is saved as-is.
88 | /// The int conveys a value that must be round tripped alongside the body in order for the decoding process to correctly interpret it. 89 | [] 90 | static member Compressed<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>, [] ?options) 91 | : IEventCodec<'Event, Encoded, 'Context> = 92 | let opts = defaultArg options CompressionOptions.Default 93 | FsCodec.Core.EventCodec.mapBodies (fun d -> Encoding.OfBlobCompress(opts, d)) Encoding.ToBlob native 94 | 95 | /// Adapts an IEventCodec rendering to ReadOnlyMemory<byte> Event Bodies to encode as per Compressed, but without attempting compression. 96 | [] 97 | static member Uncompressed<'Event, 'Context>(native: IEventCodec<'Event, ReadOnlyMemory, 'Context>) 98 | : IEventCodec<'Event, Encoded, 'Context> = 99 | FsCodec.Core.EventCodec.mapBodies Encoding.OfBlob Encoding.ToBlob native 100 | 101 | /// Adapts an IEventCodec rendering to int * ReadOnlyMemory<byte> Event Bodies to render and/or consume from Uncompressed ReadOnlyMemory<byte>. 102 | [] 103 | static member AsBlob<'Event, 'Context>(native: IEventCodec<'Event, Encoded, 'Context>) 104 | : IEventCodec<'Event, ReadOnlyMemory, 'Context> = 105 | FsCodec.Core.EventCodec.mapBodies Encoding.ToBlob Encoding.OfBlob native 106 | 107 | /// Adapts an IEventCodec rendering to int * ReadOnlyMemory<byte> Event Bodies to render and/or consume from Uncompressed byte[]. 108 | [] 109 | static member AsByteArray<'Event, 'Context>(native: IEventCodec<'Event, Encoded, 'Context>) 110 | : IEventCodec<'Event, byte[], 'Context> = 111 | FsCodec.Core.EventCodec.mapBodies (Encoding.ToBlob >> _.ToArray()) Encoding.OfBlob native 112 | -------------------------------------------------------------------------------- /src/FsCodec/FsCodec.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | netstandard2.1 7 | 8 | PKV006 9 | 3.0.0 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /src/FsCodec/StreamId.fs: -------------------------------------------------------------------------------- 1 | // Represents the second half of a canonical StreamName, i.e., the streamId in "{categoryName}-{streamId}" 2 | // Low-level helpers for composing and rendering StreamId values; prefer the ones in the Equinox namespace 3 | namespace FsCodec 4 | 5 | open FSharp.UMX 6 | open System 7 | 8 | /// Represents the second half of a canonical StreamName, i.e., the streamId in "{categoryName}-{streamId}" 9 | type StreamId = string 10 | and [] streamId 11 | 12 | /// Helpers for composing and rendering StreamId values 13 | module StreamId = 14 | 15 | /// Any string can be a StreamId; parse/dec/Elements.split will judge whether it adheres to a valid form 16 | let create: string -> StreamId = UMX.tag 17 | 18 | /// Render as a string for external use 19 | let toString: StreamId -> string = UMX.untag 20 | 21 | module Element = 22 | 23 | let [] Separator = '_' // separates {subId1_subId2_..._subIdN} 24 | 25 | /// Throws if a candidate id element includes a '_', is null, or is empty 26 | let inline validate (raw: string) = 27 | if raw |> String.IsNullOrEmpty then invalidArg "raw" "Element must not be null or empty" 28 | if raw.IndexOf Separator <> -1 then invalidArg "raw" "Element may not contain embedded '_' symbols" 29 | 30 | module Elements = 31 | 32 | let [] Separator = "_" 33 | 34 | /// Create a StreamId, trusting the input to be well-formed (see the gen* functions for composing with validation) 35 | let trust (raw: string): StreamId = UMX.tag raw 36 | 37 | /// Creates from exactly one fragment. Throws if the fragment embeds a `_`, are `null`, or is empty 38 | let parseExactlyOne (rawFragment: string): StreamId = 39 | Element.validate rawFragment 40 | trust rawFragment 41 | 42 | /// Combines streamId fragments. Throws if any of the fragments embed a `_`, are `null`, or are empty 43 | let compose (rawFragments: string[]): StreamId = 44 | rawFragments |> Array.iter Element.validate 45 | String.Join(Separator, rawFragments) |> trust 46 | 47 | let private separator = [| Element.Separator |] 48 | /// Splits a streamId into its constituent fragments 49 | let split (x: StreamId): string[] = 50 | (toString x).Split separator 51 | /// Splits a streamId into its constituent fragments 52 | let (|Split|): StreamId -> string[] = split 53 | 54 | /// Helpers to generate StreamIds given a number of individual id to string mapper functions 55 | [] 56 | type Gen private () = 57 | 58 | /// Generate a StreamId from a single application-level id, given a rendering function that maps to a non empty fragment without embedded `_` chars 59 | static member Map(f: 'a -> string) = Func<'a, StreamId>(fun id -> f id |> Elements.parseExactlyOne) 60 | /// Generate a StreamId from a tuple of application-level ids, given 2 rendering functions that map to a non empty fragment without embedded `_` chars 61 | static member Map(f, f2) = Func<'a, 'b, StreamId>(fun id1 id2 -> Elements.compose [| f id1; f2 id2 |]) 62 | /// Generate a StreamId from a triple of application-level ids, given 3 rendering functions that map to a non empty fragment without embedded `_` chars 63 | static member Map(f1, f2, f3) = Func<'a, 'b, 'c, StreamId>(fun id1 id2 id3 -> Elements.compose [| f1 id1; f2 id2; f3 id3 |]) 64 | /// Generate a StreamId from a 4-tuple of application-level ids, given 4 rendering functions that map to a non empty fragment without embedded `_` chars 65 | static member Map(f1, f2, f3, f4) = Func<'a, 'b, 'c, 'd, StreamId>(fun id1 id2 id3 id4 -> Elements.compose [| f1 id1; f2 id2; f3 id3; f4 id4 |]) 66 | 67 | /// Generate a StreamId from a single application-level id, given a rendering function that maps to a non empty fragment without embedded `_` chars 68 | let gen (f: 'a -> string): 'a -> StreamId = Gen.Map(f).Invoke 69 | /// Generate a StreamId from a tuple of application-level ids, given two rendering functions that map to a non empty fragment without embedded `_` chars 70 | let gen2 f1 f2 struct (a: 'a, b: 'b): StreamId = Gen.Map(f1, f2).Invoke(a, b) 71 | /// Generate a StreamId from a triple of application-level ids, given three rendering functions that map to a non empty fragment without embedded `_` chars 72 | let gen3 f1 f2 f3 struct (a: 'a, b: 'b, c: 'c): StreamId = Gen.Map(f1, f2, f3).Invoke(a, b, c) 73 | /// Generate a StreamId from a 4-tuple of application-level ids, given four rendering functions that map to a non empty fragment without embedded `_` chars 74 | let gen4 f1 f2 f3 f4 struct (a: 'a, b: 'b, c: 'c, d: 'd): StreamId = Gen.Map(f1, f2, f3, f4).Invoke(a, b, c, d) 75 | 76 | /// Validates and extracts the StreamId into a single fragment value 77 | /// Throws if the item embeds a `_`, is `null`, or is empty 78 | let parseExactlyOne (x: StreamId): string = toString x |> Elements.parseExactlyOne |> toString 79 | /// Validates and extracts the StreamId into a single fragment value 80 | /// Throws if the item embeds a `_`, is `null`, or is empty 81 | let (|Parse1|) (x: StreamId): string = parseExactlyOne x 82 | 83 | /// Splits a StreamId into the specified number of fragments. 84 | /// Throws if the value does not adhere to the expected fragment count. 85 | let parse count (x: StreamId): string[] = 86 | let xs = Elements.split x 87 | if xs.Length <> count then 88 | invalidArg "x" (sprintf "StreamId '{%s}' must have {%d} elements, but had {%d}." (toString x) count xs.Length) 89 | xs 90 | /// Splits a StreamId into an expected number of fragments. 91 | /// Throws if the value does not adhere to the expected fragment count. 92 | let (|Parse|) count: StreamId -> string[] = parse count 93 | 94 | /// Extracts a single fragment from the StreamId. Throws if the value is composed of more than one item. 95 | let dec f (x: StreamId) = parseExactlyOne x |> f 96 | /// Extracts 2 fragments from the StreamId. Throws if the value does not adhere to that expected form. 97 | let dec2 f1 f2 (x: StreamId) = let xs = parse 2 x in struct (f1 xs[0], f2 xs[1]) 98 | /// Extracts 3 fragments from the StreamId. Throws if the value does not adhere to that expected form. 99 | let dec3 f1 f2 f3 (x: StreamId) = let xs = parse 3 x in struct (f1 xs[0], f2 xs[1], f3 xs[2]) 100 | /// Extracts 4 fragments from the StreamId. Throws if the value does not adhere to that expected form. 101 | let dec4 f1 f2 f3 f4 (x: StreamId) = let xs = parse 4 x in struct (f1 xs[0], f2 xs[1], f3 xs[2], f4 xs[3]) 102 | -------------------------------------------------------------------------------- /src/FsCodec/StreamName.fs: -------------------------------------------------------------------------------- 1 | // StreamName type and module; Manages creation and parsing of well-formed Stream Names 2 | namespace FsCodec 3 | 4 | open FSharp.UMX 5 | 6 | /// Lightly-wrapped well-formed Stream Name adhering to one of two forms:
7 | /// 1. {category}-{streamId}
8 | /// 2. {category}-{id1}_{id2}_...{idN}
9 | /// See 10 | type StreamName = string 11 | and [] streamName 12 | 13 | /// Creates, Parses and Matches Stream Names in one of two forms:
{category}-{streamId} 15 | /// 2. {category}-{id1}_{id2}_...{idN} 16 | module StreamName = 17 | 18 | /// Strip off the strong typing (In general, it's recommended to pattern match instead) 19 | /// NOTE As a UMX type, Object.ToString will render equivalent to this 20 | let inline toString (x: StreamName): string = UMX.untag x 21 | 22 | // Validation helpers, etc. 23 | module Category = 24 | 25 | let [] Separator = '-' // separates {category}-{streamId} 26 | let [] SeparatorStr = "-" 27 | let internal separator = [| Separator |] 28 | 29 | /// Throws if a candidate category includes a '-', is null, or is empty 30 | let inline validate (raw: string) = 31 | if raw |> System.String.IsNullOrEmpty then invalidArg "raw" "Category must not be null or empty" 32 | if raw.IndexOf Separator <> -1 then invalidArg "raw" "Category must not contain embedded '-' symbols" 33 | 34 | /// Extracts the category portion of the StreamName 35 | let ofStreamName (x: StreamName) = 36 | let raw = toString x 37 | raw.Substring(0, raw.IndexOf Separator) 38 | 39 | /// Extracts the category portion of a StreamName 40 | let (|Category|): StreamName -> string = Category.ofStreamName 41 | 42 | module Internal = 43 | 44 | /// Attempts to split a Stream Name in the form {category}-{streamId} into its two elements.
45 | /// The {streamId} segment is permitted to include embedded '-' (dash) characters.
46 | /// Returns None if it does not adhere to that form. 47 | let tryParse (raw: string): struct (string * StreamId) voption = 48 | match raw.Split(Category.separator, 2) with 49 | | [| cat; id |] -> ValueSome struct (cat, StreamId.Elements.trust id) 50 | | _ -> ValueNone 51 | 52 | /// Attempts to split a Stream Name in the form {category}-{streamId} into its two elements..
53 | /// The {streamId} segment is permitted to include embedded '-' (dash) characters.
54 | /// Yields NotCategorized if it does not adhere to that form. 55 | let (|Categorized|NotCategorized|) (raw: string): Choice = 56 | match tryParse raw with 57 | | ValueSome catAndId -> Categorized catAndId 58 | | ValueNone -> NotCategorized 59 | 60 | let throwInvalid raw = invalidArg "raw" (sprintf "Stream Name '%s' must contain a '-' separator" raw) 61 | 62 | /// Create a StreamName, trusting the input to be well-formed 63 | let trust (raw: string): StreamName = UMX.tag raw 64 | 65 | /// Validates and maps a Stream Name consisting of a Category and an StreamId separated by a '-' (dash).
66 | /// Throws InvalidArgumentException if it does not adhere to that form. 67 | let parse (raw: string): StreamName = 68 | if raw.IndexOf Category.Separator = -1 then Internal.throwInvalid raw 69 | raw |> Internal.trust 70 | 71 | /// Creates a StreamName in the canonical form; a category identifier and an streamId representing the aggregate's identity 72 | /// category is separated from id by `-` 73 | let create (category: string) (streamId: StreamId): StreamName = 74 | Category.validate category 75 | System.String.Concat(category, Category.SeparatorStr, StreamId.toString streamId) |> Internal.trust 76 | 77 | /// Composes a StreamName from a category and >= 0 name elements..
78 | /// category is separated from the streamId by '-'; elements are separated from each other by '_'.
79 | /// Throws InvalidArgumentException if category embeds '-' symbols, or elements embed '_' symbols. 80 | let compose (categoryName: string) (streamIdElements: string[]): StreamName = 81 | create categoryName (StreamId.Elements.compose streamIdElements) 82 | 83 | /// Splits a well-formed Stream Name of the form {category}-{streamId} into its two elements.
84 | /// Throws InvalidArgumentException if it does not adhere to the well known format (i.e. if it was not produced by `parse`). 85 | /// Inverse of create 86 | let split (streamName: StreamName): struct (string * StreamId) = 87 | let rawName = toString streamName 88 | match Internal.tryParse rawName with 89 | | ValueSome catAndId -> catAndId 90 | | ValueNone -> Internal.throwInvalid rawName // Yes, it _should_ never happen 91 | /// Splits a well-formed Stream Name of the form {category}-{streamId} into its two elements.
92 | /// Throws InvalidArgumentException if the stream name is not well-formed. 93 | /// Inverse of create 94 | let (|Split|): StreamName -> struct (string * StreamId) = split 95 | 96 | /// Yields the StreamId, if the Category matches the specified one 97 | let tryFind categoryName (x: StreamName): StreamId voption = 98 | match split x with 99 | | cat, id when cat = categoryName -> id |> ValueSome 100 | | _ -> ValueNone 101 | -------------------------------------------------------------------------------- /src/FsCodec/StringId.fs: -------------------------------------------------------------------------------- 1 | namespace FsCodec 2 | 3 | /// Endows any type that inherits this class with standard .NET comparison semantics using a supplied token identifier 4 | [] 5 | type Comparable<'TComp, 'Token when 'TComp :> Comparable<'TComp, 'Token> and 'Token: comparison>(token: 'Token) = 6 | member private _.Token = token 7 | override x.Equals y = match y with :? Comparable<'TComp, 'Token> as y -> x.Token = y.Token | _ -> false 8 | override _.GetHashCode() = hash token 9 | interface System.IComparable with 10 | member x.CompareTo y = 11 | match y with 12 | | :? Comparable<'TComp, 'Token> as y -> compare x.Token y.Token 13 | | _ -> invalidArg "y" "invalid comparand" 14 | 15 | /// Endows any type that inherits this class with standard .NET comparison semantics using a supplied token identifier 16 | /// + treats the token as the canonical rendition for `ToString()` purposes 17 | [] 18 | type StringId<'TComp when 'TComp :> Comparable<'TComp, string>>(token: string) = 19 | inherit Comparable<'TComp, string>(token) 20 | override _.ToString() = token 21 | -------------------------------------------------------------------------------- /src/FsCodec/TypeSafeEnum.fs: -------------------------------------------------------------------------------- 1 | /// Utilities for working with F# DUs that have no bodies (i.e. pass both the Union.isUnion and Union.isNullary tests) 2 | module FsCodec.TypeSafeEnum 3 | 4 | open System 5 | open System.Collections.Generic 6 | open System.ComponentModel 7 | 8 | let isTypeSafeEnum t = Union.isUnion t && Union.isNullary t 9 | 10 | [] 11 | let tryParseTF (t: Type) = Union.Info.tryFindCaseValueWithName t 12 | [] 13 | let parseTF (t: Type) = 14 | let tryParseF = tryParseTF t 15 | let fail value = sprintf "Could not find case '%s' for type '%s'" value t.FullName |> KeyNotFoundException |> raise 16 | fun predicate (str: string) -> 17 | match predicate str |> tryParseF with 18 | | Some e -> e 19 | | None -> fail str 20 | [] 21 | let parseT (t: Type) = parseTF t (=) 22 | 23 | let tryParseF<'T> = 24 | let tryParse = tryParseTF typeof<'T> 25 | fun predicate str -> predicate str |> tryParse |> Option.map (fun e -> e :?> 'T) 26 | let tryParse<'T> = tryParseF<'T> (=) 27 | let parseF<'T> f = 28 | let p = parseTF typeof<'T> f 29 | fun (str: string) -> p str :?> 'T 30 | let parse<'T> = parseF<'T> (=) 31 | 32 | let toString<'t> : 't -> string = Union.caseName<'t> 33 | 34 | /// Yields all the cases available for 't, which must be a TypeSafeEnum, i.e. have only nullary cases. 35 | let caseValues<'t> : 't[] = Union.Info.caseValues<'t> 36 | -------------------------------------------------------------------------------- /src/FsCodec/Union.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.Union 2 | 3 | open Microsoft.FSharp.Reflection 4 | open System 5 | open System.ComponentModel 6 | 7 | let private memoize (f: 'T -> 'S): 'T -> 'S = 8 | let cache = System.Collections.Concurrent.ConcurrentDictionary<'T, 'S>() 9 | fun t -> cache.GetOrAdd(t, f) 10 | 11 | [] 12 | type CaseInfo = { name: string; fields: System.Reflection.PropertyInfo[]; construct: obj[] -> obj; deconstruct: obj -> obj[] } 13 | 14 | [] 15 | type Info = { cases: CaseInfo[]; getCase: obj -> CaseInfo } 16 | 17 | [] 18 | module Info = 19 | let get: Type -> Info = memoize (fun t -> 20 | let cases = FSharpType.GetUnionCases(t, true) |> Array.map (fun i -> 21 | { name = i.Name 22 | fields = i.GetFields() 23 | construct = FSharpValue.PreComputeUnionConstructor(i, true) 24 | deconstruct = FSharpValue.PreComputeUnionReader(i, true) }) 25 | let getTag = FSharpValue.PreComputeUnionTagReader(t, true) 26 | let getCase value = cases[getTag value] 27 | { cases = cases; getCase = getCase }) 28 | let tryFindCaseWithName u (predicate: string -> bool): CaseInfo option = u.cases |> Array.tryFind (fun c -> predicate c.name) 29 | let caseValues<'t> : 't[] = (get typeof<'t>).cases |> Array.map (fun c -> c.construct Array.empty :?> 't) 30 | let caseValuesT: Type -> obj[] = memoize (fun t -> (get t).cases |> Array.map (fun c -> c.construct Array.empty)) 31 | let tryFindCaseValueWithName (t: Type): (string -> bool) -> obj option = 32 | let u = get t 33 | let caseValue = let values = caseValuesT t in fun i -> values[i] 34 | fun predicate -> u.cases |> Array.tryFindIndex (fun c -> predicate c.name) |> Option.map caseValue 35 | 36 | /// Determines whether the type is a Union 37 | let isUnion: Type -> bool = memoize (fun t -> FSharpType.IsUnion(t, true)) 38 | 39 | /// Determines whether a union has no bodies (and hence can use a TypeSafeEnum.parse and/or TypeSafeEnumConverter) 40 | let isNullary (t: Type) = let u = Info.get t in u.cases |> Array.forall (fun case -> case.fields.Length = 0) 41 | 42 | [] 43 | let caseNameT (t: Type) (x: obj) = ((Info.get t).getCase x).name 44 | 45 | /// Yields the case name for a given value, regardless of whether it isNullary or not. 46 | let caseName<'t>(x: 't) = ((Info.get typeof<'t>).getCase x).name 47 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/Examples.fsx: -------------------------------------------------------------------------------- 1 | // Compile the fsproj by either a) right-clicking or b) typing 2 | // dotnet build tests/FsCodec.NewtonsoftJson.Tests before attempting to send this to FSI with Alt-Enter 3 | 4 | #if !USE_LOCAL_BUILD 5 | #I "bin/Debug/net9.0" 6 | #r "FsCodec.dll" 7 | #r "Newtonsoft.Json.dll" 8 | #r "FsCodec.NewtonsoftJson.dll" 9 | #r "TypeShape.dll" 10 | #r "Serilog.dll" 11 | #r "Serilog.Sinks.Console.dll" 12 | #else 13 | #r "nuget: FsCodec.NewtonsoftJson, *-*" 14 | #r "nuget: Serilog.Sinks.Console" 15 | #endif 16 | 17 | open FsCodec.NewtonsoftJson 18 | type JsonConverterAttribute = Newtonsoft.Json.JsonConverterAttribute 19 | open System 20 | 21 | module Contract = 22 | 23 | type Item = { value : string option } 24 | // implies an OptionConverter will be applied 25 | let private serdes = Serdes.Default 26 | let serialize (x : Item) : string = serdes.Serialize x 27 | let deserialize (json : string) = serdes.Deserialize json 28 | 29 | module Contract2 = 30 | 31 | type TypeThatRequiresMyCustomConverter = { mess : int } 32 | type MyCustomConverter() = inherit JsonPickler() override _.Read(_,_) = "" override _.Write(_,_,_) = () 33 | type Item = { Value : string option; other : TypeThatRequiresMyCustomConverter } 34 | /// Options to be used within this contract 35 | // note OptionConverter is also included by default; Value field will write as `"value"` 36 | let private options = Options.Create(MyCustomConverter(), camelCase = true) 37 | let private serdes = Serdes options 38 | let serialize (x : Item) = serdes.Serialize x 39 | let deserialize (json : string) : Item = serdes.Deserialize json 40 | 41 | let serdes = Serdes.Default 42 | 43 | (* Global vs local Converters 44 | 45 | It's recommended to avoid global converters, for at least the following reasons: 46 | - they're less efficient 47 | - they're more easy to get wrong if you have the wrong policy in place 48 | - Explicit is better than implicit *) 49 | type GuidConverter() = 50 | inherit JsonIsomorphism() 51 | override _.Pickle g = g.ToString "N" 52 | override _.UnPickle g = Guid.Parse g 53 | 54 | type WithEmbeddedGuid = { a: string; [)>] b: Guid } 55 | 56 | serdes.Serialize { a = "testing"; b = Guid.Empty } 57 | // {"a":"testing","b":"00000000000000000000000000000000"} 58 | 59 | serdes.Serialize Guid.Empty 60 | // "00000000-0000-0000-0000-000000000000" 61 | 62 | let serdesWithGuidConverter = Options.Create(converters = [| GuidConverter() |]) |> Serdes 63 | serdesWithGuidConverter.Serialize(Guid.Empty) 64 | // 00000000000000000000000000000000 65 | 66 | (* TypeSafeEnumConverter basic usage *) 67 | 68 | // The default rendering, without any converters in force, is a generic rendering 69 | // This treats the values in a manner consistent with how DU values with bodies are treated 70 | type Status = Initial | Active 71 | type StatusMessage = { name: string option; status: Status } 72 | let status = { name = None; status = Initial } 73 | // The problems here are: 74 | // 1. the value has lots of noise, which consumes storage space, and makes parsing harder 75 | // 2. other languages which would naturally operate on the string value if it was presented as such will have problems parsing 76 | // 3. it's also simply unnecessarily hard to read as a human 77 | serdes.Serialize status 78 | // "{"name":null,"status":{"Case":"Initial"}}" 79 | let serdesFormatted = Serdes(Options.Create(indent = true)) 80 | 81 | // If we pretty-print it, things get worse, not better: 82 | serdesFormatted.Serialize(status) 83 | // "{ 84 | // "name": null, 85 | // "status": { 86 | // "Case": "Initial" 87 | // } 88 | // }" 89 | 90 | // We can override this with the Newtonsoft.Json.JsonConverter Attribute 91 | 92 | open FsCodec.NewtonsoftJson 93 | let serdes2 = Serdes.Default 94 | [)>] 95 | type Status2 = Initial | Active 96 | type StatusMessage2 = { name: string option; status: Status2 } 97 | let status2 = { name = None; status = Initial } 98 | serdes2.Serialize status2 99 | // "{"name":null,"status":"Initial"}" 100 | 101 | // A single registered converter supplied when creating the Serdes can automatically map all Nullary Unions to strings: 102 | let serdesWithConverter = Serdes(Options.Create(TypeSafeEnumConverter())) 103 | // NOTE: no JsonConverter attribute 104 | type Status3 = Initial | Active 105 | type StatusMessage3 = { name: string option; status: Status3 } 106 | let status3 = { name = None; status = Initial } 107 | serdesWithConverter.Serialize status3 108 | // "{"name":null,"status":"Initial"}" 109 | 110 | [)>] 111 | type Outcome = Joy | Pain | Misery 112 | 113 | type Message = { name: string option; outcome: Outcome } 114 | 115 | let value = { name = Some null; outcome = Joy} 116 | serdes.Serialize value 117 | // {"name":null,"outcome":"Joy"} 118 | 119 | serdes.Deserialize """{"name":null,"outcome":"Joy"}""" 120 | // val it : Message = {name = None; outcome = Joy;} 121 | 122 | // By design, we throw when a value is unknown. Often this is the correct design. 123 | // If, and only if, your software can do something useful with catch-all case, see the technique in `OutcomeWithOther` 124 | try serdes.Deserialize """{"name":null,"outcome":"Discomfort"}""" with e -> printf "%A" e; Unchecked.defaultof 125 | // System.Collections.Generic.KeyNotFoundException: Could not find case 'Discomfort' for type 'FSI_0012+Outcome' 126 | 127 | (* TypeSafeEnumConverter fallback 128 | 129 | While, in general, one wants to version contracts such that invalid values simply don't arise, 130 | in some cases you want to explicitly handle out of range values. 131 | Here we implement a converter as a JsonIsomorphism to achieve such a mapping *) 132 | 133 | [)>] 134 | type OutcomeWithOther = Joy | Pain | Misery | Other 135 | and OutcomeWithCatchAllConverter() = 136 | inherit JsonIsomorphism() 137 | override _.Pickle v = 138 | FsCodec.TypeSafeEnum.toString v 139 | 140 | override _.UnPickle json = 141 | json 142 | |> FsCodec.TypeSafeEnum.tryParse 143 | |> Option.defaultValue Other 144 | 145 | type Message2 = { name: string option; outcome: OutcomeWithOther } 146 | 147 | let value2 = { name = Some null; outcome = Joy} 148 | serdes.Serialize value2 149 | // {"name":null,"outcome":"Joy"} 150 | 151 | serdes.Deserialize """{"name":null,"outcome":"Joy"}""" 152 | // val it : Message = {name = None; outcome = Joy;} 153 | 154 | serdes.Deserialize """{"name":null,"outcome":"Discomfort"}""" 155 | // val it : Message = {name = None; outcome = Other;} 156 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/Fixtures.fs: -------------------------------------------------------------------------------- 1 | #if SYSTEM_TEXT_JSON 2 | module FsCodec.SystemTextJson.Tests.Fixtures 3 | 4 | open FsCodec.SystemTextJson // JsonIsomorphism 5 | open System.Text.Json.Serialization // JsonConverter 6 | #else 7 | module FsCodec.NewtonsoftJson.Tests.Fixtures 8 | 9 | open FsCodec.NewtonsoftJson // JsonIsomorphism 10 | open Newtonsoft.Json // JsonConverter 11 | #endif 12 | 13 | open System 14 | open System.Runtime.Serialization 15 | 16 | /// Endows any type that inherits this class with standard .NET comparison semantics using a supplied token identifier 17 | [] 18 | type Comparable<'TComp, 'Token when 'TComp :> Comparable<'TComp, 'Token> and 'Token : comparison>(token: 'Token) = 19 | member val private Token = token // I can haz protected? 20 | override x.Equals y = match y with :? Comparable<'TComp, 'Token> as y -> x.Token = y.Token | _ -> false 21 | override _.GetHashCode() = hash token 22 | interface IComparable with 23 | member x.CompareTo y = 24 | match y with 25 | | :? Comparable<'TComp, 'Token> as y -> compare x.Token y.Token 26 | | _ -> invalidArg "y" "invalid comparand" 27 | 28 | /// SkuId strongly typed id 29 | [); AutoSerializable(false); StructuredFormatDisplay("{Value}")>] 30 | // (Internally a string for most efficient copying semantics) 31 | type SkuId private (id : string) = 32 | inherit Comparable(id) 33 | [] // Prevent swashbuckle inferring there's a "value" field 34 | member val Value = id 35 | override _.ToString() = id 36 | new (guid: Guid) = SkuId (guid.ToString("N")) 37 | // NB tests (specifically, empty) lean on having a ctor of this shape 38 | new() = SkuId(Guid.NewGuid()) 39 | // NB for validation [and XSS] purposes we prove it translatable to a Guid 40 | static member Parse(input: string) = SkuId (Guid.Parse input) 41 | /// Represent as a Guid.ToString("N") output externally 42 | and private SkuIdJsonConverter() = 43 | inherit JsonIsomorphism() 44 | /// Renders as per Guid.ToString("N") 45 | override _.Pickle value = value.Value 46 | /// Input must be a Guid.Parseable value 47 | override _.UnPickle input = SkuId.Parse input 48 | 49 | /// CartId strongly typed id 50 | [); AutoSerializable(false); StructuredFormatDisplay("{Value}")>] 51 | // (Internally a string for most efficient copying semantics) 52 | type CartId private (id : string) = 53 | inherit Comparable(id) 54 | [] // Prevent swashbuckle inferring there's a "value" field 55 | member val Value = id 56 | override _.ToString() = id 57 | // NB tests lean on having a ctor of this shape 58 | new (guid: Guid) = CartId (guid.ToString("N")) 59 | // NB for validation [and XSS] purposes we must prove it translatable to a Guid 60 | static member Parse(input: string) = CartId (Guid.Parse input) 61 | /// Represent as a Guid.ToString("N") output externally 62 | and private CartIdJsonConverter() = 63 | inherit JsonIsomorphism() 64 | /// Renders as per Guid.ToString("N") 65 | override _.Pickle value = value.Value 66 | /// Input must be a Guid.Parseable value 67 | override _.UnPickle input = CartId.Parse input 68 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/FsCodec.NewtonsoftJson.Tests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net9.0 5 | false 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | all 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/PicklerTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.NewtonsoftJson.Tests.PicklerTests 2 | 3 | open FsCodec.NewtonsoftJson 4 | open Newtonsoft.Json 5 | open Swensen.Unquote 6 | open System 7 | open Xunit 8 | 9 | open FsCodec.NewtonsoftJson.Tests.Fixtures 10 | 11 | // NB Feel free to ignore this opinion and copy the 4 lines into your own globals - the pinning test will remain here 12 | /// 13 | /// Renders all Guids without dashes. 14 | /// 15 | /// 16 | /// Can work correctly as a global converter, as some codebases do for historical reasons 17 | /// Could arguably be usable as base class for various converters, including the above. 18 | /// However, the above pattern and variants thereof are recommended for new types. 19 | /// In general, the philosophy is that, beyond the Pickler base types, an identiy type should consist of explicit 20 | /// code as much as possible, and global converters really have to earn their keep - magic starts with -100 points. 21 | /// 22 | type GuidConverter() = 23 | inherit JsonIsomorphism() 24 | override _.Pickle g = g.ToString "N" 25 | override _.UnPickle g = Guid.Parse g 26 | 27 | type WithEmbeddedGuid = { a: string; [)>] b: Guid } 28 | 29 | let [] ``Tagging with GuidConverter`` () = 30 | let value = { a = "testing"; b = Guid.Empty } 31 | 32 | let result = JsonConvert.SerializeObject value 33 | 34 | test <@ """{"a":"testing","b":"00000000000000000000000000000000"}""" = result @> 35 | 36 | let [] ``Global GuidConverter`` () = 37 | let value = Guid.Empty 38 | 39 | let resDashes = JsonConvert.SerializeObject(value, Options.Default) 40 | let resNoDashes = JsonConvert.SerializeObject(value, Options.Create(GuidConverter())) 41 | 42 | test <@ "\"00000000-0000-0000-0000-000000000000\"" = resDashes 43 | && "\"00000000000000000000000000000000\"" = resNoDashes @> 44 | 45 | module ``Adding Fields Example`` = 46 | 47 | module CartV1 = 48 | type CreateCart = { name: string } 49 | 50 | module CartV2Null = 51 | type CreateCart = { name: string; CartId: CartId } 52 | 53 | module CartV2 = 54 | type CreateCart = { name: string; CartId: CartId option } 55 | 56 | let [] ``Deserialize missing field as null value`` () = 57 | let createCartV1: CartV1.CreateCart = { name = "cartName" } 58 | // let expectedCreateCartV2: CartV2Null.CreateCart = { Name = "cartName"; CartId = null } // The type 'CartId' does not have 'null' as a proper value 59 | 60 | let createCartV1Json = JsonConvert.SerializeObject createCartV1 61 | 62 | let createCartV2 = JsonConvert.DeserializeObject(createCartV1Json) 63 | 64 | test <@ Unchecked.defaultof<_> = createCartV2.CartId @> // isNull or `null =` will be rejected 65 | 66 | let [] ``Deserialize missing field as an optional property None value`` () = 67 | let createCartV1: CartV1.CreateCart = { name = "cartName" } 68 | 69 | let createCartV1Json = JsonConvert.SerializeObject createCartV1 70 | 71 | let createCartV2 = JsonConvert.DeserializeObject(createCartV1Json) 72 | 73 | test <@ Option.isNone createCartV2.CartId @> 74 | 75 | module ``Upconversion example`` = 76 | 77 | module Events = 78 | type Properties = { a: string } 79 | type PropertiesV2 = { a: string; b: int } 80 | type Event = 81 | | PropertiesUpdated of {| properties:Properties |} 82 | | PropertiesUpdatedV2 of {| properties:PropertiesV2 |} 83 | 84 | module EventsUpDown = 85 | type Properties = { a: string } 86 | type PropertiesV2 = { a: string; b: int } 87 | module PropertiesV2 = 88 | let defaultB = 2 89 | /// The possible representations within the store 90 | [] 91 | type Contract = 92 | | PropertiesUpdated of {| properties: Properties |} 93 | | PropertiesUpdatedV2 of {| properties: PropertiesV2 |} 94 | interface TypeShape.UnionContract.IUnionContract 95 | /// Used in the model - all decisions and folds are in terms of this 96 | type Event = 97 | | PropertiesUpdated of {| properties: PropertiesV2 |} 98 | 99 | let up: Contract -> Event = function 100 | | Contract.PropertiesUpdated e -> PropertiesUpdated {| properties = { a = e.properties.a; b = PropertiesV2.defaultB } |} 101 | | Contract.PropertiesUpdatedV2 e -> PropertiesUpdated e 102 | let down: Event -> Contract = function 103 | | Event.PropertiesUpdated e -> Contract.PropertiesUpdatedV2 e 104 | let codec = Codec.Create(up = (fun _e c -> up c), 105 | down = fun e -> struct (down e, ValueNone, ValueNone)) 106 | 107 | module Fold = 108 | 109 | type State = unit 110 | // evolve functions 111 | let evolve state = function 112 | | EventsUpDown.Event.PropertiesUpdated e -> state 113 | 114 | module ``Upconversion active patterns`` = 115 | 116 | module Events = 117 | type Properties = { a: string } 118 | type PropertiesV2 = { a: string; b: int } 119 | module PropertiesV2 = 120 | let defaultB = 2 121 | type Event = 122 | | PropertiesUpdated of {| properties: Properties |} 123 | | PropertiesUpdatedV2 of {| properties: PropertiesV2 |} 124 | let (|Updated|) = function 125 | | PropertiesUpdated e -> {| properties = { a = e.properties.a; b = PropertiesV2.defaultB } |} 126 | | PropertiesUpdatedV2 e -> e 127 | module Fold = 128 | type State = { b : int } 129 | let evolve state : Events.Event -> State = function 130 | | Events.Updated e -> { state with b = e.properties.b } 131 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/SomeNullHandlingTests.fs: -------------------------------------------------------------------------------- 1 | #if SYSTEM_TEXT_JSON 2 | module FsCodec.SystemTextJson.Tests.SomeNullHandlingTests 3 | 4 | open FsCodec.SystemTextJson 5 | open Swensen.Unquote 6 | open Xunit 7 | 8 | let serdes = Serdes.Default 9 | 10 | let [] ``Options.Create does not roundtrip Some null`` () = 11 | let value : string option = Some null 12 | let ser = serdes.Serialize value 13 | "null" =! ser 14 | // But it doesn't roundtrip 15 | value <>! serdes.Deserialize ser 16 | 17 | #else 18 | module FsCodec.NewtonsoftJson.Tests.SomeNullHandlingTests 19 | 20 | open FsCodec.NewtonsoftJson 21 | open Swensen.Unquote 22 | open Xunit 23 | 24 | let ootb = Options.CreateDefault() |> Serdes 25 | let serdes = Serdes.Default 26 | 27 | let [] ``Options.CreateDefault roundtrips null string option, but rendering is ugly`` () = 28 | let value : string option = Some null 29 | let ser = ootb.Serialize value 30 | test <@ ser = "{\"Case\":\"Some\",\"Fields\":[null]}" @> 31 | test <@ value = ootb.Deserialize ser @> 32 | 33 | let [] ``Options.Create does not roundtrip Some null`` () = 34 | let value : string option = Some null 35 | let ser = serdes.Serialize value 36 | "null" =! ser 37 | // But it doesn't roundtrip 38 | value <>! serdes.Deserialize ser 39 | #endif 40 | 41 | let hasSomeNull value = TypeShape.Generic.exists(fun (x : string option) -> x = Some null) value 42 | let replaceSomeNullsWithNone value = TypeShape.Generic.map (function Some (null : string) -> None | x -> x) value 43 | 44 | let [] ``Workaround is to detect and/or substitute such non-roundtrippable values`` () = 45 | 46 | let value : string option = Some null 47 | // So we detect the condition (we could e.g. exclude such cases from the tests) 48 | test <@ hasSomeNull value @> 49 | // Or we can plough on, replacing the input with a roundtrippable value 50 | let value : string option = replaceSomeNullsWithNone value 51 | None =! value 52 | test <@ (not << hasSomeNull) value @> 53 | let ser = serdes.Serialize value 54 | ser =! "null" 55 | // ... and validate that the [substituted] value did roundtrip 56 | test <@ value = serdes.Deserialize ser @> 57 | 58 | type RecordWithStringOptions = { x : int; y : Nested } 59 | and Nested = { z : string option } 60 | 61 | let [] ``Can detect and/or substitute null string option when using Options.Create`` () = 62 | let value : RecordWithStringOptions = { x = 9; y = { z = Some null } } 63 | test <@ hasSomeNull value @> 64 | let value = replaceSomeNullsWithNone value 65 | test <@ (not << hasSomeNull) value @> 66 | let ser = serdes.Serialize value 67 | ser =! """{"x":9,"y":{"z":null}}""" 68 | test <@ value = serdes.Deserialize ser @> 69 | 70 | #if SYSTEM_TEXT_JSON 71 | // As one might expect, the ignoreNulls setting is also honored 72 | let ignoreNullsSerdes = Options.Create(ignoreNulls = true) |> Serdes 73 | #else 74 | // As one might expect, the ignoreNulls setting is also honored 75 | let ignoreNullsSerdes = Options.Create(ignoreNulls = true) |> Serdes 76 | #endif 77 | let ser = ignoreNullsSerdes.Serialize value 78 | ser =! """{"x":9,"y":{}}""" 79 | test <@ value = serdes.Deserialize ser @> 80 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/StreamTests.fs: -------------------------------------------------------------------------------- 1 | #if SYSTEM_TEXT_JSON 2 | module FsCodec.SystemTextJson.Tests.StreamTests 3 | open FsCodec.SystemTextJson 4 | #else 5 | module FsCodec.NewtonsoftJson.Tests.StreamTests 6 | open FsCodec.NewtonsoftJson 7 | #endif 8 | 9 | open Swensen.Unquote 10 | open System.IO 11 | open Xunit 12 | 13 | let serdes = Serdes.Default 14 | 15 | type Rec = { a : int; b : string; c : string } 16 | let [] ``Can serialize/deserialize to stream`` () = 17 | let value = { a = 10; b = "10"; c = "" } 18 | use stream = new MemoryStream() 19 | serdes.SerializeToStream(value, stream) 20 | stream.Seek(0L, SeekOrigin.Begin) |> ignore 21 | let value' = serdes.DeserializeFromStream(stream) 22 | test <@ value = value' @> 23 | -------------------------------------------------------------------------------- /tests/FsCodec.NewtonsoftJson.Tests/VerbatimUtf8ConverterTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests 2 | 3 | open FsCheck.Xunit 4 | open FsCodec.NewtonsoftJson 5 | open Newtonsoft.Json 6 | open System 7 | open Swensen.Unquote 8 | open global.Xunit 9 | 10 | type Embedded = { embed : string } 11 | type Union = 12 | | A of Embedded 13 | | B of Embedded 14 | interface TypeShape.UnionContract.IUnionContract 15 | 16 | type EmbeddedString = { embed : string } 17 | type EmbeddedDate = { embed : DateTime } 18 | type EmbeddedDateTimeOffset = { embed : DateTimeOffset } 19 | type U = 20 | | R of Embedded 21 | //| ED of EmbeddedDate // Not recommended; gets mangled by timezone adjustments 22 | //| S of string // Too messy/confusing to support 23 | //| DTO of DateTimeOffset // Have not delved into what the exact problem is; no point implementing if strings cant work 24 | //| DT of DateTime // Have not analyzed but seems to be same issue as DTO 25 | | EDto of EmbeddedDateTimeOffset 26 | | ES of EmbeddedString 27 | //| I of int // works but removed as no other useful top level values work 28 | | N 29 | interface TypeShape.UnionContract.IUnionContract 30 | 31 | type [] 32 | Event = 33 | { t: DateTimeOffset // ISO 8601 34 | c: string // required 35 | [)>] 36 | [] 37 | d: byte[] // Required, but can be null so Nullary cases can work 38 | 39 | [)>] 40 | [] 41 | m: byte[] } // optional 42 | type [] 43 | Batch = 44 | { [] // Not requested in queries 45 | p: string 46 | id: string 47 | [] 48 | _etag: string 49 | i: int64 50 | n: int64 51 | e: Event[] } 52 | let mkBatch (encoded : FsCodec.IEventData>) : Batch = 53 | { p = "streamName"; id = string 0; i = -1L; n = -1L; _etag = null 54 | e = [| { t = DateTimeOffset.MinValue; c = encoded.EventType; d = (let d = encoded.Data in d.ToArray()); m = null } |] } 55 | 56 | #nowarn "1182" // From hereon in, we may have some 'unused' privates (the tests) 57 | 58 | module VerbatimUtf8Tests = // not a module or CI will fail for net461 59 | 60 | let eventCodec = Codec.Create() 61 | 62 | let [] ``encodes correctly`` () = 63 | let input = Union.A { embed = "\"" } 64 | let encoded = eventCodec.Encode((), input) 65 | let e : Batch = mkBatch encoded 66 | let res = JsonConvert.SerializeObject(e) 67 | test <@ res.Contains """"d":{"embed":"\""}""" @> 68 | let des = JsonConvert.DeserializeObject(res) 69 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e[0].c, ReadOnlyMemory des.e[0].d) 70 | let decoded = eventCodec.Decode loaded |> ValueOption.get 71 | input =! decoded 72 | 73 | let defaultSettings = Options.CreateDefault() 74 | let defaultEventCodec = Codec.Create(defaultSettings) 75 | 76 | let [] ``round-trips diverse bodies correctly`` (x: U) = 77 | let encoded = defaultEventCodec.Encode((), x) 78 | let e : Batch = mkBatch encoded 79 | let ser = JsonConvert.SerializeObject(e, defaultSettings) 80 | let des = JsonConvert.DeserializeObject(ser, defaultSettings) 81 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e[0].c, ReadOnlyMemory des.e[0].d) 82 | let decoded = defaultEventCodec.Decode loaded |> ValueOption.get 83 | x =! decoded 84 | 85 | // https://github.com/JamesNK/Newtonsoft.Json/issues/862 // doesnt apply to this case 86 | let [] ``Codec does not fall prey to Date-strings being mutilated`` () = 87 | let x = ES { embed = "2016-03-31T07:02:00+07:00" } 88 | let encoded = defaultEventCodec.Encode((), x) 89 | let adapted = FsCodec.Core.TimelineEvent.Create(-1L, encoded) 90 | let decoded = defaultEventCodec.Decode adapted |> ValueOption.get 91 | test <@ x = decoded @> 92 | 93 | //// NB while this aspect works, we don't support it as it gets messy when you then use the VerbatimUtf8Converter 94 | //let sEncoder = Codec.Create(defaultSettings) 95 | //let [] ``Codec can roundtrip strings`` (value: string) = 96 | // let x = SS value 97 | // let encoded = sEncoder.Encode x 98 | // let decoded = sEncoder.Decode encoded |> Option.get 99 | // test <@ x = decoded @> 100 | 101 | module VerbatimUtf8NullHandling = 102 | 103 | type [] EventHolderWithAndWithoutRequired = 104 | { /// Event body, as UTF-8 encoded JSON ready to be injected directly into the Json being rendered 105 | [)>] 106 | d: byte[] // required 107 | 108 | /// Optional metadata, as UTF-8 encoded JSON, ready to emit directly (entire field is not written if value is null) 109 | [)>] 110 | [] 111 | m: byte[] } 112 | 113 | let values : obj[][] = 114 | [| [| null |] 115 | [| [||] |] 116 | [| System.Text.Encoding.UTF8.GetBytes "{}" |] |] 117 | 118 | [] 119 | let ``round-trips nulls and empties consistently`` value = 120 | let e : EventHolderWithAndWithoutRequired = { d = value; m = value } 121 | let ser = JsonConvert.SerializeObject(e) 122 | let des = JsonConvert.DeserializeObject(ser) 123 | test <@ ((e.m = null || e.m.Length = 0) && (des.m = null)) || System.Linq.Enumerable.SequenceEqual(e.m, des.m) @> 124 | test <@ ((e.d = null || e.d.Length = 0) && (des.d = null)) || System.Linq.Enumerable.SequenceEqual(e.d, des.d) @> 125 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.AutoUnionTests 2 | 3 | open FsCodec 4 | open FsCodec.SystemTextJson 5 | open Swensen.Unquote 6 | 7 | type ATypeSafeEnum = A | B | C 8 | type NotAUnion = { body : string; opt : string option; list: string list } 9 | type AUnion = D of value : string | E of ATypeSafeEnum | F | G of value : string option 10 | type Any = Tse of enum : ATypeSafeEnum | Not of NotAUnion | Union of AUnion 11 | 12 | let serdes = Options.Create(autoTypeSafeEnumToJsonString = true, autoUnionToJsonObject = true) |> Serdes 13 | 14 | let [] ``Basic characteristics`` () = 15 | test <@ "\"B\"" = serdes.Serialize B @> 16 | test <@ "{\"body\":\"A\",\"opt\":null,\"list\":[]}" = serdes.Serialize { body = "A"; opt = None ; list = [] } @> 17 | test <@ "{\"body\":\"A\",\"opt\":\"A\",\"list\":[\"A\"]}" = serdes.Serialize { body = "A"; opt = Some "A"; list = ["A"] } @> 18 | test <@ "{\"body\":\"A\",\"opt\":\"A\",\"list\":[]}" = serdes.Serialize { body = "A"; opt = Some "A"; list = [] } @> 19 | test <@ "{\"case\":\"D\",\"value\":\"A\"}" = serdes.Serialize (D "A") @> 20 | test <@ "{\"case\":\"G\",\"value\":\"A\"}" = serdes.Serialize (G (Some "A")) @> 21 | test <@ "{\"case\":\"Tse\",\"enum\":\"B\"}" = serdes.Serialize (Tse B) @> 22 | test <@ Tse B = serdes.Deserialize "{\"case\":\"Tse\",\"enum\":\"B\"}" @> 23 | test <@ Not { body = "A"; opt = None; list = [] } = serdes.Deserialize "{\"case\":\"Not\",\"body\":\"A\",\"list\":[]}" @> 24 | test <@ Not { body = "A"; opt = None; list = ["A"] } = serdes.Deserialize "{\"case\":\"Not\",\"body\":\"A\",\"list\":[\"A\"]}" @> 25 | 26 | let [] ``Opting out`` () = 27 | let serdesDef = Serdes.Default 28 | let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes 29 | let serdesU = Options.Create(autoUnionToJsonObject = true) |> Serdes 30 | 31 | raises <@ serdesU.Serialize(Tse A) @> 32 | raises <@ serdesDef.Serialize(Tse A) @> 33 | test <@ Tse A = Tse A |> serdesT.Serialize |> serdesT.Deserialize @> 34 | 35 | raises <@ serdesDef.Serialize(Union F) @> 36 | raises <@ serdesT.Serialize(Union F) @> 37 | test <@ Union F = Union F |> serdesT.Serialize |> serdesT.Deserialize @> 38 | 39 | module TypeSafeEnumConversion = 40 | 41 | type SimpleTruth = True | False 42 | 43 | let [] ``is case sensitive`` () = 44 | let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes 45 | True =! serdesT.Deserialize "\"True\"" 46 | raises <@ serdesT.Deserialize "\"true\"" @> 47 | 48 | module ``Overriding With Case Insensitive`` = 49 | 50 | [)>] 51 | type Truth = 52 | | True | False | FileNotFound 53 | static member Parse: string -> Truth = TypeSafeEnum.parseF(fun s inp -> s.Equals(inp, System.StringComparison.OrdinalIgnoreCase)) 54 | and LogicalConverter() = 55 | inherit JsonIsomorphism() 56 | override _.Pickle x = match x with FileNotFound -> "lost" | x -> TypeSafeEnum.toString x 57 | override _.UnPickle input = Truth.Parse input 58 | 59 | let [] ``specific converter wins`` () = 60 | let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes 61 | let serdesDef = Serdes.Default 62 | for serdes in [| serdesT; serdesDef |] do 63 | test <@ FileNotFound = serdes.Deserialize "\"fileNotFound\"" @> 64 | test <@ "\"lost\"" = serdes.Serialize FileNotFound @> 65 | 66 | let [] ``auto-encodes Unions and non-unions`` (x : Any) = 67 | let encoded = serdes.Serialize x 68 | let decoded : Any = serdes.Deserialize encoded 69 | 70 | // Special cases for (non roundtrip capable) Some null => None conversion that STJ (and NSJ OptionConverter) do 71 | // See next test for a debatable trick 72 | match decoded, x with 73 | | Union (G None), Union (G (Some null)) -> () 74 | | Not rr, Not ({ opt = Some null } as rx) -> test <@ rr = { rx with opt = None } @> 75 | | _ -> 76 | 77 | test <@ decoded = x @> 78 | 79 | let [] ``It round trips`` (x: Any) = 80 | let encoded = serdes.Serialize x 81 | let decoded : Any = serdes.Deserialize encoded 82 | test <@ decoded = x @> 83 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/CodecTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.CodecTests 2 | 3 | open FsCodec.SystemTextJson 4 | open FsCodec.SystemTextJson.Interop // bring in ToUtf8Codec, ToJsonElementCodec extension methods 5 | open System.Text.Json 6 | open FsCheck.Xunit 7 | open Swensen.Unquote 8 | 9 | type Embedded = { embed : string } 10 | type EmbeddedWithOption = { embed : string; opt : string option } 11 | type Union = 12 | | A of Embedded 13 | | B of Embedded 14 | | AO of EmbeddedWithOption 15 | | BO of EmbeddedWithOption 16 | interface TypeShape.UnionContract.IUnionContract 17 | 18 | let ignoreNullOptions = Options.Create(ignoreNulls = true) 19 | let elementEncoder : TypeShape.UnionContract.IEncoder = 20 | FsCodec.SystemTextJson.Core.JsonElementEncoder(Serdes ignoreNullOptions) :> _ 21 | 22 | let eventCodec = CodecJsonElement.Create(ignoreNullOptions) 23 | let multiHopCodec = eventCodec.ToUtf8Codec().ToJsonElementCodec() 24 | 25 | [] 26 | type Envelope = { d : JsonElement } 27 | 28 | let [] roundtrips value = 29 | let eventType, embedded = 30 | match value with 31 | | A e -> "A", Choice1Of2 e 32 | | AO e -> "AO",Choice2Of2 e 33 | | B e -> "B", Choice1Of2 e 34 | | BO e -> "BO",Choice2Of2 e 35 | let encoded = 36 | match embedded with 37 | | Choice1Of2 e -> elementEncoder.Encode e 38 | | Choice2Of2 eo -> elementEncoder.Encode eo 39 | let enveloped = { d = encoded } 40 | 41 | // the options should be irrelevant, but use the defaults (which would add nulls in that we don't want if it was leaking) 42 | let serdes = Serdes.Default 43 | let ser = serdes.Serialize enveloped 44 | 45 | match embedded with 46 | | Choice1Of2 { embed = null } 47 | | Choice2Of2 { embed = null; opt = None } -> 48 | test <@ ser = """{"d":{}}""" @> 49 | | Choice2Of2 { embed = null; opt = Some null } -> 50 | test <@ ser = """{"d":{"opt":null}}""" @> 51 | | Choice2Of2 { embed = null } -> 52 | test <@ ser.StartsWith("""{"d":{"opt":""") @> 53 | | Choice2Of2 { opt = x } -> 54 | test <@ ser.StartsWith """{"d":{"embed":""" && ser.Contains "opt" = Option.isSome x @> 55 | | Choice1Of2 _ -> 56 | test <@ ser.StartsWith """{"d":{"embed":""" && not (ser.Contains "\"opt\"") @> 57 | 58 | let des = serdes.Deserialize ser 59 | let wrapped = FsCodec.Core.TimelineEvent.Create(-1L, eventType, des.d) 60 | test <@ wrapped.EventId = System.Guid.Empty 61 | && (let d = System.DateTimeOffset.UtcNow - wrapped.Timestamp 62 | abs d.TotalMinutes < 1) @> 63 | let decoded = eventCodec.Decode wrapped |> ValueOption.get 64 | let expected = 65 | match value with 66 | | AO ({ opt = Some null } as v) -> AO { v with opt = None } 67 | | BO ({ opt = Some null } as v) -> BO { v with opt = None } 68 | | x -> x 69 | test <@ expected = decoded @> 70 | 71 | // Also validate the adapters work when put in series (NewtonsoftJson tests are responsible for covering the individual hops) 72 | let decodedMultiHop = multiHopCodec.Decode wrapped |> ValueOption.get 73 | test <@ expected = decodedMultiHop @> 74 | 75 | let [] ``EventData.Create basics`` () = 76 | let e = FsCodec.Core.EventData.Create("et", "data") 77 | 78 | test <@ e.EventId <> System.Guid.Empty 79 | && e.EventType = "et" 80 | && e.Data = "data" 81 | && (let d = System.DateTimeOffset.UtcNow - e.Timestamp 82 | abs d.TotalMinutes < 1) @> 83 | 84 | let [] ``TimelineEvent.Create basics`` () = 85 | let e = FsCodec.Core.TimelineEvent.Create(42, "et", "data") 86 | 87 | test <@ e.EventId = System.Guid.Empty 88 | && not e.IsUnfold 89 | && e.EventType = "et" 90 | && e.Data = "data" 91 | && (let d = System.DateTimeOffset.UtcNow - e.Timestamp 92 | abs d.TotalMinutes < 1) @> 93 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/EncodingTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.EncodingTests 2 | 3 | open Swensen.Unquote 4 | open System 5 | open System.Text.Json 6 | open Xunit 7 | 8 | let inline roundtrip (sut: FsCodec.IEventCodec<'event, 'F, unit>) value = 9 | let encoded = sut.Encode((), value = value) 10 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, encoded) 11 | sut.Decode loaded 12 | 13 | (* Base Fixture Round-trips a String encoded as JsonElement *) 14 | 15 | module StringUtf8 = 16 | 17 | let eventType = "EventType" 18 | let enc (x: 't): JsonElement = JsonSerializer.SerializeToElement x 19 | let dec (b: JsonElement): 't = JsonSerializer.Deserialize b 20 | let jsonElementCodec<'t> = 21 | let encode e = struct (eventType, enc e) 22 | let decode s (b: JsonElement) = if s = eventType then ValueSome (dec b) else invalidOp "Invalid eventType value" 23 | FsCodec.Codec.Create(encode, decode) 24 | 25 | let sut<'t> = jsonElementCodec<'t> 26 | 27 | let [] roundtrips () = 28 | let value = {| value = "Hello World" |} 29 | let res' = roundtrip sut value 30 | res' =! ValueSome value 31 | 32 | module InternalDecoding = 33 | 34 | let inputValue = {| value = "Hello World" |} 35 | // A JsonElement that's a JSON Object should be handled as an uncompressed value 36 | let direct = struct (0, JsonSerializer.SerializeToElement inputValue) 37 | let explicitDeflate = struct (1, JsonSerializer.SerializeToElement "qlYqS8wpTVWyUvJIzcnJVwjPL8pJUaoFAAAA//8=") 38 | let explicitBrotli = struct (2, JsonSerializer.SerializeToElement "CwuAeyJ2YWx1ZSI6IkhlbGxvIFdvcmxkIn0D") 39 | 40 | let decode useRom = 41 | if useRom then fun x -> JsonSerializer.Deserialize(FsCodec.SystemTextJson.Encoding.ToUtf8(x).Span) 42 | else FsCodec.SystemTextJson.Encoding.ToJsonElement >> JsonSerializer.Deserialize 43 | 44 | let [] ``Can decode all known representations`` useRom = 45 | test <@ decode useRom direct = inputValue @> 46 | test <@ decode useRom explicitDeflate = inputValue @> 47 | test <@ decode useRom explicitBrotli = inputValue @> 48 | 49 | let [] ``Defaults to leaving the body alone if unknown`` useRom = 50 | let struct (_, je) = direct 51 | let body = struct (99, je) 52 | let decoded = decode useRom body 53 | test <@ decoded = inputValue @> 54 | 55 | let [] ``Defaults to leaving the body alone if string`` useRom = 56 | let body = struct (99, JsonSerializer.SerializeToElement "test") 57 | let decoded = decode useRom body 58 | test <@ "test" = decoded @> 59 | 60 | type JsonElement with member x.Utf8ByteCount = if x.ValueKind = JsonValueKind.Null then 0 else x.GetRawText() |> System.Text.Encoding.UTF8.GetByteCount 61 | 62 | module TryCompress = 63 | 64 | let sut = FsCodec.SystemTextJson.Encoder.Compressed StringUtf8.sut 65 | 66 | let compressibleValue = {| value = String('x', 5000) |} 67 | 68 | let [] roundtrips () = 69 | let res' = roundtrip sut compressibleValue 70 | res' =! ValueSome compressibleValue 71 | 72 | let [] ``compresses when possible`` () = 73 | let encoded = sut.Encode((), value = compressibleValue) 74 | let struct (_encoding, encodedValue) = encoded.Data 75 | encodedValue.Utf8ByteCount ] ``produces equivalent JsonElement where compression not possible`` () = 78 | let value = {| value = "NotCompressible" |} 79 | let directResult = StringUtf8.sut.Encode((), value).Data 80 | let failedToCompressResult = sut.Encode((), value = value) 81 | let struct (_encoding, result) = failedToCompressResult.Data 82 | true =! JsonElement.DeepEquals(directResult, result) 83 | 84 | module Uncompressed = 85 | 86 | let sut = FsCodec.SystemTextJson.Encoder.Uncompressed StringUtf8.sut 87 | 88 | // Borrow the value we just demonstrated to be compressible 89 | let compressibleValue = TryCompress.compressibleValue 90 | 91 | let [] roundtrips () = 92 | let rom = ReadOnlyMemory(null : byte[]) 93 | let res' = roundtrip sut compressibleValue 94 | res' =! ValueSome compressibleValue 95 | 96 | let [] ``does not compress (despite it being possible to)`` () = 97 | let directResult = StringUtf8.sut.Encode((), compressibleValue).Data 98 | let shouldNotBeCompressedResult = sut.Encode((), value = compressibleValue) 99 | let struct (_encoding, result) = shouldNotBeCompressedResult.Data 100 | result.Utf8ByteCount =! directResult.Utf8ByteCount 101 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net9.0 5 | false 6 | SYSTEM_TEXT_JSON 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | all 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | Fixtures.fs 36 | 37 | 38 | UnionConverterTests.fs 39 | 40 | 41 | 42 | 43 | SomeNullHandlingTests.fs 44 | 45 | 46 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/InteropTests.fs: -------------------------------------------------------------------------------- 1 | /// Covers adapting of Codecs that map to JsonElement to instead map to ReadOnlyMemory, and interop with the VerbatimUtf8Converter 2 | module FsCodec.SystemTextJson.Tests.InteropTests 3 | 4 | open FsCheck.Xunit 5 | open Newtonsoft.Json 6 | open Swensen.Unquote 7 | open System 8 | open Xunit 9 | 10 | type Batch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Batch 11 | type Union = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Union 12 | let mkBatch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.mkBatch 13 | 14 | let indirectCodec = FsCodec.SystemTextJson.CodecJsonElement.Create() |> FsCodec.SystemTextJson.Interop.InteropHelpers.ToUtf8Codec 15 | let [] ``encodes correctly`` () = 16 | let input = Union.A { embed = "\"" } 17 | let encoded = indirectCodec.Encode((), input) 18 | let e : Batch = mkBatch encoded 19 | let res = JsonConvert.SerializeObject(e) 20 | test <@ res.Contains """"d":{"embed":"\""}""" @> 21 | let des = JsonConvert.DeserializeObject(res) 22 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e[0].c, ReadOnlyMemory des.e[0].d) 23 | let decoded = indirectCodec.Decode loaded |> ValueOption.get 24 | input =! decoded 25 | 26 | type EmbeddedString = { embed : string } 27 | type EmbeddedDateTimeOffset = { embed : DateTimeOffset } 28 | type U = 29 | // | S of string // Opens up some edge cases wrt handling missing/empty/null `d` fields in stores, but possible if you have time to shave that yak! 30 | | EDto of EmbeddedDateTimeOffset 31 | | ES of EmbeddedString 32 | | N 33 | interface TypeShape.UnionContract.IUnionContract 34 | 35 | let defaultSettings = FsCodec.NewtonsoftJson.Options.CreateDefault() // Test without converters, as that's what Equinox.Cosmos will do 36 | let defaultEventCodec = FsCodec.NewtonsoftJson.Codec.Create(defaultSettings) 37 | let indirectCodecU = FsCodec.SystemTextJson.CodecJsonElement.Create() |> FsCodec.SystemTextJson.Interop.InteropHelpers.ToUtf8Codec 38 | 39 | let [] ``round-trips diverse bodies correctly`` (x: U, encodeDirect, decodeDirect) = 40 | let encoder = if encodeDirect then defaultEventCodec else indirectCodecU 41 | let decoder = if decodeDirect then defaultEventCodec else indirectCodecU 42 | let encoded = encoder.Encode((), x) 43 | let e : Batch = mkBatch encoded 44 | let ser = JsonConvert.SerializeObject(e, defaultSettings) 45 | let des = JsonConvert.DeserializeObject(ser, defaultSettings) 46 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e[0].c, ReadOnlyMemory des.e[0].d) 47 | let decoded = decoder.Decode loaded |> ValueOption.get 48 | x =! decoded 49 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/PicklerTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.PicklerTests 2 | 3 | open FsCodec.SystemTextJson 4 | open Swensen.Unquote 5 | open System 6 | open System.Text.Json 7 | open Xunit 8 | 9 | // NB Feel free to ignore this opinion and copy the 4 lines into your own globals - the pinning test will remain here 10 | /// 11 | /// Renders Guids without dashes. 12 | /// 13 | /// 14 | /// Can work correctly as a global converter, as some codebases do for historical reasons 15 | /// Could arguably be usable as base class for various converters, including the above. 16 | /// However, both of these usage patterns and variants thereof are not recommended for new types. 17 | /// In general, the philosophy is that, beyond the Pickler base types, an identity type should consist of explicit 18 | /// code as much as possible, and global converters really have to earn their keep - magic starts with -100 points. 19 | /// 20 | type GuidConverter() = 21 | inherit JsonIsomorphism() 22 | override _.Pickle g = g.ToString "N" 23 | override _.UnPickle g = Guid.Parse g 24 | 25 | type WithEmbeddedGuid = { a: string; [)>] b: Guid } 26 | 27 | type Configs() as this = 28 | inherit TheoryData() 29 | do this.Add(Options.CreateDefault()) // validate it works with minimal converters 30 | this.Add(Options.Default) // Flush out clashes with standard converter set 31 | this.Add(Options.Create()) // Flush out clashes with standard converter set 32 | this.Add(Options.Create(GuidConverter())) // and a global registration does not conflict 33 | 34 | let [)>] ``Tagging with GuidConverter roundtrips`` (options : JsonSerializerOptions) = 35 | let value = { a = "testing"; b = Guid.Empty } 36 | let serdes = Serdes options 37 | let result = serdes.Serialize value 38 | 39 | test <@ """{"a":"testing","b":"00000000000000000000000000000000"}""" = result @> 40 | 41 | let des = serdes.Deserialize result 42 | test <@ value = des @> 43 | 44 | let serdes = Serdes(Options.Default) 45 | 46 | let [] ``Global GuidConverter roundtrips`` () = 47 | let value = Guid.Empty 48 | 49 | let defaultHandlingHasDashes = serdes.Serialize value 50 | 51 | let serdesWithConverter = Options.Create(GuidConverter()) |> Serdes 52 | let resNoDashes = serdesWithConverter.Serialize value 53 | 54 | test <@ "\"00000000-0000-0000-0000-000000000000\"" = defaultHandlingHasDashes 55 | && "\"00000000000000000000000000000000\"" = resNoDashes @> 56 | 57 | // Non-dashed is not accepted by default handling in STJ (Newtonsoft does accept it) 58 | raises <@ serdes.Deserialize resNoDashes @> 59 | 60 | // With the converter, things roundtrip either way 61 | for result in [defaultHandlingHasDashes; resNoDashes] do 62 | let des = serdesWithConverter.Deserialize result 63 | test <@ value = des @> 64 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/SerdesTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.SerdesTests 2 | 3 | open System 4 | open System.Collections.Generic 5 | open FsCodec.SystemTextJson 6 | open Swensen.Unquote 7 | open Xunit 8 | 9 | type Record = { a : int } 10 | 11 | type RecordWithOption = { a : int; b : string option } 12 | type RecordWithString = { c : int; d : string } 13 | 14 | /// Characterization tests for OOTB JSON.NET 15 | /// The aim here is to characterize the gaps that we'll shim; we only want to do that as long as it's actually warranted 16 | module StjCharacterization = 17 | let ootb = Options.CreateDefault() |> Serdes 18 | 19 | let [] ``OOTB STJ records Just Works`` () = 20 | // Ver 5.x includes standard support for calling a single ctor (4.x required a custom implementation) 21 | let value = { a = 1 } 22 | let ser = ootb.Serialize value 23 | test <@ ser = """{"a":1}""" @> 24 | 25 | let res = ootb.Deserializeser 26 | test <@ res = value @> 27 | 28 | let [] ``OOTB STJ options Just Works`` () = 29 | let value = { a = 1; b = Some "str" } 30 | let ser = ootb.Serialize value 31 | test <@ ser = """{"a":1,"b":"str"}""" @> 32 | 33 | test <@ value = ootb.Deserialize ser @> 34 | 35 | let [] ``OOTB STJ Some null decodes as None as per NSJ`` () = 36 | let value = { a = 1; b = Some null } 37 | let ser = ootb.Serialize value 38 | test <@ ser = """{"a":1,"b":null}""" @> 39 | 40 | // sic: does not roundtrip 41 | test <@ { value with b = None } = ootb.Deserialize ser @> 42 | 43 | let [] ``OOTB STJ lists Just Works`` () = 44 | let value = [ "A"; "B" ] 45 | let ser = ootb.Serialize value 46 | test <@ ser = """["A","B"]""" @> 47 | 48 | test <@ value = ootb.Deserialize ser @> 49 | 50 | // System.Text.Json's JsonSerializerOptions by default escapes HTML-sensitive characters when generating JSON strings 51 | // while this arguably makes sense as a default 52 | // - it's not particularly relevant for event encodings 53 | // - and is not in alignment with the FsCodec.NewtonsoftJson default options 54 | // see https://github.com/dotnet/runtime/issues/28567#issuecomment-53581752 for lowdown 55 | type OverescapedOptions() as this = 56 | inherit TheoryData() 57 | 58 | do // OOTB System.Text.Json over-escapes HTML-sensitive characters - `CreateDefault` honors this 59 | this.Add(Options.CreateDefault()) // the value we use here one required two custom Converters 60 | // Options.Create provides a simple way to override it 61 | this.Add(Options.Create(unsafeRelaxedJsonEscaping = false)) 62 | let [)>] ``provides various ways to use HTML-escaped encoding``(opts : System.Text.Json.JsonSerializerOptions) = 63 | let value = { a = 1; b = Some "\"" } 64 | let serdes = Serdes opts 65 | let ser = serdes.Serialize value 66 | test <@ ser = """{"a":1,"b":"\u0022"}""" @> 67 | let des = serdes.Deserialize ser 68 | test <@ value = des @> 69 | 70 | let [] ``RejectNullStringConverter rejects null strings`` () = 71 | let serdes = Serdes(Options.Create(rejectNullStrings = true)) 72 | 73 | let value: string = null 74 | raises <@ serdes.Serialize value @> 75 | 76 | let value = [| "A"; null |] 77 | raises <@ serdes.Serialize value @> 78 | 79 | let value = { c = 1; d = null } 80 | raises <@ serdes.Serialize value @> 81 | 82 | let [] ``RejectNullStringConverter serializes strings correctly`` () = 83 | let serdes = Serdes(Options.Create(rejectNullStrings = true)) 84 | let value = { c = 1; d = "some string" } 85 | let res = serdes.Serialize value 86 | test <@ res = """{"c":1,"d":"some string"}""" @> 87 | let des = serdes.Deserialize res 88 | test <@ des = value @> 89 | 90 | [] 91 | let ``string options are supported regardless of "rejectNullStrings" value`` rejectNullStrings = 92 | let serdes = Serdes(Options.Create(rejectNullStrings = rejectNullStrings)) 93 | let value = [| Some "A"; None |] 94 | let res = serdes.Serialize value 95 | test <@ res = """["A",null]""" @> 96 | let des = serdes.Deserialize res 97 | test <@ des = value @> 98 | 99 | 100 | (* Serdes + default Options behavior, i.e. the stuff we do *) 101 | 102 | let serdes = Serdes.Default 103 | 104 | let [] records () = 105 | let value = { a = 1 } 106 | let res = serdes.Serialize value 107 | test <@ res = """{"a":1}""" @> 108 | let des = serdes.Deserialize res 109 | test <@ value = des @> 110 | 111 | let [] arrays () = 112 | let value = [|"A"; "B"|] 113 | let res = serdes.Serialize value 114 | test <@ res = """["A","B"]""" @> 115 | let des = serdes.Deserialize res 116 | test <@ value = des @> 117 | 118 | let [] options () = 119 | let value : RecordWithOption = { a = 1; b = Some "str" } 120 | let ser = serdes.Serialize value 121 | test <@ ser = """{"a":1,"b":"str"}""" @> 122 | let des = serdes.Deserialize ser 123 | test <@ value = des @> 124 | 125 | // For maps, represent the value as an IDictionary<'K, 'V> or Dictionary and parse into a model as appropriate 126 | let [] maps () = 127 | let value = Map(seq { "A",1; "b",2 }) 128 | let ser = serdes.Serialize> value 129 | test <@ ser = """{"A":1,"b":2}""" @> 130 | let des = serdes.Deserialize> ser 131 | test <@ value = Map.ofSeq (des |> Seq.map (|KeyValue|)) @> 132 | 133 | type RecordWithArrayOption = { str : string; arr : string[] option } 134 | type RecordWithArrayVOption = { str : string; arr : string[] voption } 135 | 136 | // Instead of using `list`s, it's recommended to use arrays as one would in C# 137 | // where there's a possibility of deserializing a missing or null value, that hence maps to a `null` value 138 | // A supported way of managing this is by wrapping the array in an `option` 139 | let [] ``array options`` () = 140 | let value = [|"A"; "B"|] 141 | let res = serdes.Serialize value 142 | test <@ res = """["A","B"]""" @> 143 | let des = serdes.Deserialize res 144 | test <@ Some value = des @> 145 | let des = serdes.Deserialize "null" 146 | test <@ None = des @> 147 | let des = serdes.Deserialize "{}" 148 | test <@ { str = null; arr = ValueNone } = des @> 149 | 150 | let [] ``Switches off the HTML over-escaping mechanism`` () = 151 | let value = { a = 1; b = Some "\"+" } 152 | let ser = serdes.Serialize value 153 | test <@ ser = """{"a":1,"b":"\"+"}""" @> 154 | let des = serdes.Deserialize ser 155 | test <@ value = des @> 156 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/StringIdTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.StringIdTests 2 | 3 | open System.Collections.Generic 4 | open FsCodec.SystemTextJson 5 | open Xunit 6 | open Swensen.Unquote 7 | 8 | (* Recommended helper aliases to put in your namespace global to avoid having to open long namespaces *) 9 | 10 | type StjNameAttribute = System.Text.Json.Serialization.JsonPropertyNameAttribute 11 | type StjIgnoreAttribute = System.Text.Json.Serialization.JsonIgnoreAttribute 12 | type StjConverterAttribute = System.Text.Json.Serialization.JsonConverterAttribute 13 | 14 | module Guid = 15 | 16 | let inline gen () = System.Guid.NewGuid() 17 | let inline toStringN (x: System.Guid) = x.ToString "N" 18 | let inline parse (x: string) = System.Guid.Parse x 19 | 20 | module Bare = 21 | 22 | [)>] 23 | type SkuId(value: System.Guid) = 24 | // No JSON Ignore attribute required as read-only property 25 | member val Value = value 26 | and private SkuIdConverter() = 27 | inherit JsonIsomorphism() 28 | override _.Pickle(value: SkuId) = value.Value |> Guid.toStringN 29 | override _.UnPickle input = input |> Guid.parse |> SkuId 30 | 31 | [] 32 | let comparison () = 33 | let g = Guid.gen () 34 | let id1, id2 = SkuId g, SkuId g 35 | false =! id1.Equals id2 36 | id1 <>! id2 37 | 38 | [] 39 | let serdes () = 40 | let x = Guid.gen () |> SkuId 41 | $"\"{Guid.toStringN x.Value}\"" =! Serdes.Default.Serialize x 42 | let ser = Serdes.Default.Serialize x 43 | $"\"{x.Value}\"" <>! ser // Default render of Guid is not toStringN 44 | x.Value =! Serdes.Default.Deserialize(ser).Value 45 | 46 | let d = Dictionary() 47 | d.Add(x, "value") 48 | raises <@ Serdes.Default.Serialize d @> 49 | 50 | module StringIdIsomorphism = 51 | 52 | [)>] 53 | type SkuId(value: System.Guid) = inherit FsCodec.StringId(Guid.toStringN value) 54 | and private SkuIdConverter() = 55 | inherit JsonIsomorphism() 56 | override _.Pickle(value: SkuId) = value |> string 57 | override _.UnPickle input = input |> Guid.parse |> SkuId 58 | 59 | [] 60 | let comparison () = 61 | let g = Guid.gen() 62 | let id1, id2 = SkuId g, SkuId g 63 | true =! id1.Equals id2 64 | id1 =! id2 65 | 66 | [] 67 | let serdes () = 68 | let x = Guid.gen () |> SkuId 69 | let ser = Serdes.Default.Serialize x 70 | $"\"{x}\"" =! ser 71 | x =! Serdes.Default.Deserialize ser 72 | 73 | let d = Dictionary() 74 | d.Add(x, "value") 75 | raises <@ Serdes.Default.Serialize d @> 76 | 77 | module StringIdConverter = 78 | 79 | [)>] 80 | type SkuId(value: System.Guid) = inherit FsCodec.StringId(Guid.toStringN value) 81 | and private SkuIdConverter() = inherit StringIdConverter(Guid.parse >> SkuId) 82 | 83 | [] 84 | let comparison () = 85 | let g = Guid.gen() 86 | let id1, id2 = SkuId g, SkuId g 87 | true =! id1.Equals id2 88 | id1 =! id2 89 | 90 | [] 91 | let serdes () = 92 | let x = Guid.gen () |> SkuId 93 | $"\"{x}\"" =! Serdes.Default.Serialize x 94 | 95 | let d = Dictionary() 96 | d.Add(x, "value") 97 | raises <@ Serdes.Default.Serialize d @> 98 | 99 | module StringIdOrKeyConverter = 100 | 101 | [)>] 102 | type SkuId(value: System.Guid) = inherit FsCodec.StringId(Guid.toStringN value) 103 | and private SkuIdConverter() = inherit StringIdOrDictionaryKeyConverter(Guid.parse >> SkuId) 104 | 105 | [] 106 | let comparison () = 107 | let g = Guid.gen() 108 | let id1, id2 = SkuId g, SkuId g 109 | true =! id1.Equals id2 110 | id1 =! id2 111 | 112 | [] 113 | let serdes () = 114 | let x = Guid.gen () |> SkuId 115 | $"\"{x}\"" =! Serdes.Default.Serialize x 116 | 117 | let d = Dictionary() 118 | d.Add(x, "value") 119 | $"{{\"{x}\":\"value\"}}" =! Serdes.Default.Serialize d 120 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.SystemTextJson.Tests.TypeSafeEnumConverterTests 2 | 3 | open FsCodec 4 | open FsCodec.SystemTextJson 5 | open System 6 | open System.Collections.Generic 7 | open System.Text.Json 8 | open Swensen.Unquote 9 | open Xunit 10 | 11 | type Outcome = Joy | Pain | Misery 12 | 13 | let [] happy () = 14 | let oic (x: string) y = x.Equals(y, StringComparison.OrdinalIgnoreCase) 15 | test <@ box Joy = TypeSafeEnum.parseT typeof "Joy" @> 16 | test <@ Joy = TypeSafeEnum.parse "Joy" @> 17 | test <@ Joy = TypeSafeEnum.parseF oic "JOY" @> 18 | test <@ box Joy = TypeSafeEnum.parseT typeof "Joy" @> 19 | test <@ box Joy = TypeSafeEnum.parseTF typeof oic "Joy" @> 20 | test <@ None = TypeSafeEnum.tryParse "Wat" @> 21 | raises <@ TypeSafeEnum.parse "Wat" @> 22 | raises <@ TypeSafeEnum.parseF oic "Wat" @> 23 | 24 | let serdesWithOutcomeConverter = Options.Create(TypeSafeEnumConverter()) |> Serdes 25 | test <@ Joy = serdesWithOutcomeConverter.Deserialize "\"Joy\"" @> 26 | test <@ Some Joy = serdesWithOutcomeConverter.Deserialize "\"Joy\"" @> 27 | raises <@ serdesWithOutcomeConverter.Deserialize "\"Confusion\"" @> 28 | // Was a JsonException prior to V6 29 | let serdes = Serdes.Default 30 | raises <@ serdes.Deserialize "1" @> 31 | 32 | let [] sad () = 33 | raises <@ TypeSafeEnum.tryParse "Wat" @> 34 | raises <@ TypeSafeEnum.toString "Wat" @> 35 | 36 | [)>] 37 | type OutcomeWithOther = Joy | Pain | Misery | Other 38 | and OutcomeWithCatchAllConverter() = 39 | inherit JsonIsomorphism() 40 | override _.Pickle v = 41 | TypeSafeEnum.toString v 42 | 43 | override _.UnPickle json = 44 | json 45 | |> TypeSafeEnum.tryParse 46 | |> Option.defaultValue Other 47 | 48 | let [] fallBackExample () = 49 | let serdes = Serdes.Default 50 | test <@ Joy = serdes.Deserialize "\"Joy\"" @> 51 | test <@ Some Other = serdes.Deserialize "\"Wat\"" @> 52 | test <@ Other = serdes.Deserialize "\"Wat\"" @> 53 | raises <@ serdes.Deserialize "1" @> 54 | test <@ Seq.forall (fun (x,y) -> x = y) <| Seq.zip [Joy; Other] (serdes.Deserialize "[\"Joy\", \"Wat\"]") @> 55 | -------------------------------------------------------------------------------- /tests/FsCodec.SystemTextJson.Tests/UmxInteropTests.fs: -------------------------------------------------------------------------------- 1 | /// There's not much to see here - as UMX is a compile-time thing, it should work perfectly with System.Text.Json 2 | module FsCodec.SystemTextJson.Tests.UmxInteropTests 3 | 4 | open FsCodec.SystemTextJson 5 | open FSharp.UMX 6 | open Swensen.Unquote 7 | open System 8 | open System.Text.Json 9 | open Xunit 10 | 11 | // Borrow the converter from the suite that has validated its' core behaviors 12 | type GuidConverter = PicklerTests.GuidConverter 13 | 14 | type [] myGuid 15 | type MyGuid = Guid 16 | type WithEmbeddedMyGuid = 17 | { a: string 18 | 19 | [)>] 20 | b: MyGuid } 21 | 22 | type Configs() as this = 23 | inherit TheoryData() 24 | do this.Add("\"00000000-0000-0000-0000-000000000000\"", Options.Default) 25 | this.Add("\"00000000000000000000000000000000\"", Options.Create(GuidConverter())) 26 | 27 | let [)>] 28 | ``UMX'd Guid interops with GuidConverter and roundtrips`` 29 | (expectedSer, options : JsonSerializerOptions) = 30 | 31 | let value = Guid.Empty 32 | 33 | let serdes = Serdes options 34 | let result = serdes.Serialize value 35 | test <@ expectedSer = result @> 36 | let des = serdes.Deserialize result 37 | test <@ value = des @> 38 | -------------------------------------------------------------------------------- /tests/FsCodec.Tests/EncodingTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.Tests.EncodingTests 2 | 3 | open System 4 | open Swensen.Unquote 5 | open Xunit 6 | 7 | let inline roundtrip (sut : FsCodec.IEventCodec<_, _, _>) value = 8 | let encoded = sut.Encode((), value = value) 9 | let loaded = FsCodec.Core.TimelineEvent.Create(-1L, encoded) 10 | sut.Decode loaded 11 | 12 | (* Base Fixture Round-trips a String encoded as ReadOnlyMemory UTF-8 blob *) 13 | 14 | module StringUtf8 = 15 | 16 | let eventType = "n/a" 17 | let enc (s : string) : ReadOnlyMemory = System.Text.Encoding.UTF8.GetBytes s |> ReadOnlyMemory 18 | let dec (b : ReadOnlySpan) : string = System.Text.Encoding.UTF8.GetString b 19 | let stringUtf8Encoder = 20 | let encode e = struct (eventType, enc e) 21 | let decode s (b : ReadOnlyMemory) = if s = eventType then ValueSome (dec b.Span) else invalidOp "Invalid eventType value" 22 | FsCodec.Codec.Create(encode, decode) 23 | 24 | let sut = stringUtf8Encoder 25 | 26 | let [] roundtrips () = 27 | let value = "TestValue" 28 | let res' = roundtrip sut value 29 | res' =! ValueSome value 30 | 31 | module TryCompress = 32 | 33 | let sut = FsCodec.Encoder.Compressed(StringUtf8.sut) 34 | 35 | let compressibleValue = String('x', 5000) 36 | 37 | let [] roundtrips () = 38 | let res' = roundtrip sut compressibleValue 39 | res' =! ValueSome compressibleValue 40 | 41 | let [] ``compresses when possible`` () = 42 | let encoded = sut.Encode((), value = compressibleValue) 43 | let struct (_encoding, encodedValue) = encoded.Data 44 | encodedValue.Length ] ``uses raw value where compression not possible`` () = 47 | let value = "NotCompressible" 48 | let directResult = StringUtf8.sut.Encode((), value).Data 49 | let encoded = sut.Encode((), value = value) 50 | let struct (_encoding, result) = encoded.Data 51 | true =! directResult.Span.SequenceEqual(result.Span) 52 | 53 | module Uncompressed = 54 | 55 | let sut = FsCodec.Encoder.Uncompressed(StringUtf8.sut) 56 | 57 | // Borrow a demonstrably compressible value 58 | let value = TryCompress.compressibleValue 59 | 60 | let [] roundtrips () = 61 | let res' = roundtrip sut value 62 | res' =! ValueSome value 63 | 64 | let [] ``does not compress, even if it was possible to`` () = 65 | let directResult = StringUtf8.sut.Encode((), value).Data 66 | let encoded = sut.Encode((), value) 67 | let struct (_encoding, result) = encoded.Data 68 | true =! directResult.Span.SequenceEqual(result.Span) 69 | 70 | module Decoding = 71 | 72 | let raw = struct(0, Text.Encoding.UTF8.GetBytes("Hello World") |> ReadOnlyMemory) 73 | let deflated = struct(1, Convert.FromBase64String("8kjNyclXCM8vykkBAAAA//8=") |> ReadOnlyMemory) 74 | let brotli = struct(2, Convert.FromBase64String("CwWASGVsbG8gV29ybGQ=") |> ReadOnlyMemory) 75 | 76 | let [] ``Can decode all known bodies`` () = 77 | let decode = FsCodec.Encoding.GetStringUtf8 78 | test <@ decode raw = "Hello World" @> 79 | test <@ decode deflated = "Hello World" @> 80 | test <@ decode brotli = "Hello World" @> 81 | 82 | let [] ``Defaults to leaving the memory alone if unknown`` () = 83 | let struct(_, mem) = raw 84 | let body = struct (99, mem) 85 | let decoded = body |> FsCodec.Encoding.GetStringUtf8 86 | test <@ decoded = "Hello World" @> 87 | -------------------------------------------------------------------------------- /tests/FsCodec.Tests/FsCodec.Tests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net9.0 5 | false 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | all 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /tests/FsCodec.Tests/StreamNameTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.Tests.StreamNameTests 2 | 3 | open FsCodec 4 | open Swensen.Unquote 5 | open Xunit 6 | 7 | let [] ``Can roundtrip composed multi-ids with embedded dashes`` () = 8 | let cat, e1, e2 = "Cat", "a-b", "c-d" 9 | 10 | let sn = StreamName.compose cat [| e1; e2 |] 11 | 12 | test <@ StreamName.parse "Cat-a-b_c-d" = sn @> 13 | 14 | test <@ let (StreamName.Split (scat, StreamId.Parse 2 elems)) = sn 15 | scat = cat && [| e1; e2 |] = elems @> 16 | 17 | test <@ let (StreamName.Split (scat, sid)) = sn 18 | cat = scat 19 | && StreamId.create "a-b_c-d" = sid 20 | && (e1 + StreamId.Elements.Separator + e2) = StreamId.toString sid @> 21 | 22 | let [] ``Can roundtrip streamId with embedded dashes and underscores`` () = 23 | let cat, streamId = "Cat", "a-b_c-d" 24 | 25 | let sn = StreamName.create cat (StreamId.create streamId) 26 | 27 | test <@ StreamName.parse "Cat-a-b_c-d" = sn @> 28 | 29 | test <@ let (StreamName.Split (sCat, sid)) = sn 30 | sCat = cat 31 | && streamId = StreamId.toString sid 32 | && [| "a-b"; "c-d" |] = StreamId.parse 2 sid @> 33 | 34 | test <@ let (StreamName.Split (sCat, StreamId.Parse 2 ids)) = sn 35 | sCat = cat 36 | && [| "a-b"; "c-d" |] = ids @> 37 | 38 | let [] ``StreamName parse throws given 0 separators`` () = 39 | raisesWith <@ StreamName.parse "Cat" @> <| 40 | fun (e: System.ArgumentException) -> 41 | <@ e.ParamName = "raw" 42 | && e.Message.StartsWith "Stream Name 'Cat' must contain a '-' separator" @> 43 | -------------------------------------------------------------------------------- /tests/FsCodec.Tests/TypeSafeEnumTests.fs: -------------------------------------------------------------------------------- 1 | module FsCodec.Tests.TypeSafeEnumTests 2 | 3 | open FsCodec 4 | open Swensen.Unquote 5 | open Xunit 6 | 7 | type Outcome = Joy | Pain | Misery 8 | 9 | let [] caseNames () = 10 | [| Joy; Pain; Misery |] =! TypeSafeEnum.caseValues<_> 11 | --------------------------------------------------------------------------------