├── .gitignore ├── .paket ├── paket.bootstrapper.exe └── paket.targets ├── AssemblyInfo.fs ├── FSharpReactivePatterns.fsproj ├── FSharpReactivePatterns.sln ├── LICENSE ├── MessageConstruction ├── CommandMessage.fsx ├── CorrelationIdentifier.fsx ├── DocumentMessage.fsx ├── EventMessage.fsx ├── FormatIndicator.fsx ├── MessageExpiration.fsx ├── RequestReply.fsx └── ReturnAddress.fsx ├── MessageEndpoints ├── CompetingConsumers.fsx ├── DurableSubscriber.fsx ├── IdempotentReceiverBecome.fsx ├── IdempotentReceiverDeduplication.fsx ├── MessageDispatcher.fsx ├── MessagingGateway.fsx ├── MessagingMapper.fsx ├── PollingConsumer.fsx ├── SelectiveConsumer.fsx └── TransactionalClientActor.fsx ├── MessageRouting ├── Aggregator.fsx ├── ContentBasedRouter.fsx ├── DynamicRouter.fsx ├── MessageFilter.fsx ├── ProcessManager.fsx ├── RecipientList.fsx ├── Resequencer.fsx ├── RoutingSlip.fsx ├── ScatterGather.fsx └── Splitter.fsx ├── MessageTransformation ├── ClaimCheck.fsx ├── ContentEnricher.fsx ├── ContentFilter.fsx └── EnvelopeWrapper.fsx ├── MessagingChannels ├── ChannelAdapter.fsx ├── DatatypeChannel.fsx ├── DeadLetterChannel.fsx ├── GuaranteedDelivery.fsx ├── InvalidMessageChannel.fsx ├── MessageBridge.fsx ├── MessageBus.fsx ├── PointToPointChannel.fsx └── PublishSubscribeChannel.fsx ├── MessagingWithActors ├── Message.fsx ├── MessageChannel.fsx ├── MessageEndpoint.fsx ├── MessageRouter.fsx └── PipesAndFilters.fsx ├── Program.fs ├── References.fsx ├── SystemManagementInfrastructure ├── ChannelPurger.fsx ├── Detour.fsx ├── MessageMetadataHistory.fsx ├── SmartProxy.fsx ├── TestMessage.fsx └── WireTap.fsx ├── app.config ├── paket.dependencies ├── paket.lock └── paket.references /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | 4 | # User-specific files 5 | *.suo 6 | *.user 7 | *.userosscache 8 | *.sln.docstates 9 | 10 | # User-specific files (MonoDevelop/Xamarin Studio) 11 | *.userprefs 12 | 13 | # Build results 14 | [Dd]ebug/ 15 | [Dd]ebugPublic/ 16 | [Rr]elease/ 17 | [Rr]eleases/ 18 | x64/ 19 | x86/ 20 | build/ 21 | bld/ 22 | [Bb]in/ 23 | [Oo]bj/ 24 | 25 | # Visual Studo 2015 cache/options directory 26 | .vs/ 27 | 28 | # MSTest test Results 29 | [Tt]est[Rr]esult*/ 30 | [Bb]uild[Ll]og.* 31 | 32 | # NUNIT 33 | *.VisualState.xml 34 | TestResult.xml 35 | 36 | # Build Results of an ATL Project 37 | [Dd]ebugPS/ 38 | [Rr]eleasePS/ 39 | dlldata.c 40 | 41 | *_i.c 42 | *_p.c 43 | *_i.h 44 | *.ilk 45 | *.meta 46 | *.obj 47 | *.pch 48 | *.pdb 49 | *.pgc 50 | *.pgd 51 | *.rsp 52 | *.sbr 53 | *.tlb 54 | *.tli 55 | *.tlh 56 | *.tmp 57 | *.tmp_proj 58 | *.log 59 | *.vspscc 60 | *.vssscc 61 | .builds 62 | *.pidb 63 | *.svclog 64 | *.scc 65 | 66 | # Chutzpah Test files 67 | _Chutzpah* 68 | 69 | # Visual C++ cache files 70 | ipch/ 71 | *.aps 72 | *.ncb 73 | *.opensdf 74 | *.sdf 75 | *.cachefile 76 | 77 | # Visual Studio profiler 78 | *.psess 79 | *.vsp 80 | *.vspx 81 | 82 | # TFS 2012 Local Workspace 83 | $tf/ 84 | 85 | # Guidance Automation Toolkit 86 | *.gpState 87 | 88 | # ReSharper is a .NET coding add-in 89 | _ReSharper*/ 90 | *.[Rr]e[Ss]harper 91 | *.DotSettings.user 92 | 93 | # JustCode is a .NET coding addin-in 94 | .JustCode 95 | 96 | # TeamCity is a build add-in 97 | _TeamCity* 98 | 99 | # DotCover is a Code Coverage Tool 100 | *.dotCover 101 | 102 | # NCrunch 103 | _NCrunch_* 104 | .*crunch*.local.xml 105 | 106 | # MightyMoose 107 | *.mm.* 108 | AutoTest.Net/ 109 | 110 | # Web workbench (sass) 111 | .sass-cache/ 112 | 113 | # Installshield output folder 114 | [Ee]xpress/ 115 | 116 | # DocProject is a documentation generator add-in 117 | DocProject/buildhelp/ 118 | DocProject/Help/*.HxT 119 | DocProject/Help/*.HxC 120 | DocProject/Help/*.hhc 121 | DocProject/Help/*.hhk 122 | DocProject/Help/*.hhp 123 | DocProject/Help/Html2 124 | DocProject/Help/html 125 | 126 | # Click-Once directory 127 | publish/ 128 | 129 | # Publish Web Output 130 | *.[Pp]ublish.xml 131 | *.azurePubxml 132 | # TODO: Comment the next line if you want to checkin your web deploy settings 133 | # but database connection strings (with potential passwords) will be unencrypted 134 | *.pubxml 135 | *.publishproj 136 | 137 | # NuGet Packages 138 | *.nupkg 139 | # The packages folder can be ignored because of Package Restore 140 | **/packages/* 141 | # except build/, which is used as an MSBuild target. 142 | !**/packages/build/ 143 | # Uncomment if necessary however generally it will be regenerated when needed 144 | #!**/packages/repositories.config 145 | 146 | # Windows Azure Build Output 147 | csx/ 148 | *.build.csdef 149 | 150 | # Windows Store app package directory 151 | AppPackages/ 152 | 153 | # Others 154 | *.[Cc]ache 155 | ClientBin/ 156 | [Ss]tyle[Cc]op.* 157 | ~$* 158 | *~ 159 | *.dbmdl 160 | *.dbproj.schemaview 161 | *.pfx 162 | *.publishsettings 163 | node_modules/ 164 | bower_components/ 165 | 166 | # RIA/Silverlight projects 167 | Generated_Code/ 168 | 169 | # Backup & report files from converting an old project file 170 | # to a newer Visual Studio version. Backup files are not needed, 171 | # because we have git ;-) 172 | _UpgradeReport_Files/ 173 | Backup*/ 174 | UpgradeLog*.XML 175 | UpgradeLog*.htm 176 | 177 | # SQL Server files 178 | *.mdf 179 | *.ldf 180 | 181 | # Business Intelligence projects 182 | *.rdl.data 183 | *.bim.layout 184 | *.bim_*.settings 185 | 186 | # Microsoft Fakes 187 | FakesAssemblies/ 188 | 189 | # Node.js Tools for Visual Studio 190 | .ntvs_analysis.dat 191 | 192 | # Visual Studio 6 build log 193 | *.plg 194 | 195 | # Visual Studio 6 workspace options file 196 | *.opt 197 | .paket/paket.exe 198 | -------------------------------------------------------------------------------- /.paket/paket.bootstrapper.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jorgef/fsharpreactivepatterns/50878f192d93425ecb5b290230270f849716e13a/.paket/paket.bootstrapper.exe -------------------------------------------------------------------------------- /.paket/paket.targets: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | true 6 | 7 | true 8 | $(MSBuildThisFileDirectory) 9 | $(MSBuildThisFileDirectory)..\ 10 | /Library/Frameworks/Mono.framework/Commands/mono 11 | mono 12 | 13 | 14 | 15 | $(PaketToolsPath)paket.exe 16 | $(PaketToolsPath)paket.bootstrapper.exe 17 | "$(PaketExePath)" 18 | $(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)" 19 | "$(PaketBootStrapperExePath)" $(PaketBootStrapperCommandArgs) 20 | $(MonoPath) --runtime=v4.0.30319 $(PaketBootStrapperExePath) $(PaketBootStrapperCommandArgs) 21 | 22 | $(MSBuildProjectDirectory)\paket.references 23 | $(MSBuildStartupDirectory)\paket.references 24 | $(MSBuildProjectFullPath).paket.references 25 | $(PaketCommand) restore --references-files "$(PaketReferences)" 26 | $(PaketBootStrapperCommand) 27 | 28 | RestorePackages; $(BuildDependsOn); 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace FSharpReactivePatterns.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.CompilerServices 5 | open System.Runtime.InteropServices 6 | 7 | // General Information about an assembly is controlled through the following 8 | // set of attributes. Change these attribute values to modify the information 9 | // associated with an assembly. 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | [] 18 | 19 | // Setting ComVisible to false makes the types in this assembly not visible 20 | // to COM components. If you need to access a type in this assembly from 21 | // COM, set the ComVisible attribute to true on that type. 22 | [] 23 | 24 | // The following GUID is for the ID of the typelib if this project is exposed to COM 25 | [] 26 | 27 | // Version information for an assembly consists of the following four values: 28 | // 29 | // Major Version 30 | // Minor Version 31 | // Build Number 32 | // Revision 33 | // 34 | // You can specify all the values or you can default the Build and Revision Numbers 35 | // by using the '*' as shown below: 36 | // [] 37 | [] 38 | [] 39 | 40 | do 41 | () -------------------------------------------------------------------------------- /FSharpReactivePatterns.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Debug 6 | AnyCPU 7 | 2.0 8 | d41a0698-c9e5-42fa-9de7-97f8b2b9757b 9 | Exe 10 | FSharpReactivePatterns 11 | FSharpReactivePatterns 12 | v4.5.2 13 | true 14 | 4.4.0.0 15 | FSharpReactivePatterns 16 | 17 | 18 | 19 | true 20 | full 21 | false 22 | false 23 | bin\Debug\ 24 | DEBUG;TRACE 25 | 3 26 | AnyCPU 27 | bin\Debug\FSharpReactivePatterns.XML 28 | true 29 | 30 | 31 | pdbonly 32 | true 33 | true 34 | bin\Release\ 35 | TRACE 36 | 3 37 | AnyCPU 38 | bin\Release\FSharpReactivePatterns.XML 39 | true 40 | 41 | 42 | 11 43 | 44 | 45 | 46 | 47 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets 48 | 49 | 50 | 51 | 52 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 131 | 132 | 133 | 134 | 135 | 136 | packages\Akka\lib\net45\Akka.dll 137 | True 138 | True 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | packages\Akka.FSharp\lib\net45\Akka.FSharp.dll 148 | True 149 | True 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | packages\Akka.Persistence\lib\net45\Akka.Persistence.dll 159 | True 160 | True 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | packages\Akka.Persistence.FSharp\lib\net45\Akka.Persistence.FSharp.dll 170 | True 171 | True 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | packages\FSharp.Core\lib\net40\FSharp.Core.dll 181 | True 182 | True 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | packages\FsPickler\lib\net45\FsPickler.dll 192 | True 193 | True 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | packages\FSPowerPack.Core.Community\Lib\Net40\FSharp.PowerPack.dll 203 | True 204 | True 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | packages\FSPowerPack.Linq.Community\Lib\Net40\FSharp.PowerPack.Linq.dll 214 | True 215 | True 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | packages\Google.ProtocolBuffers\lib\net40\Google.ProtocolBuffers.Serialization.dll 225 | True 226 | True 227 | 228 | 229 | packages\Google.ProtocolBuffers\lib\net40\Google.ProtocolBuffers.dll 230 | True 231 | True 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | packages\Newtonsoft.Json\lib\net45\Newtonsoft.Json.dll 241 | True 242 | True 243 | 244 | 245 | 246 | 247 | -------------------------------------------------------------------------------- /FSharpReactivePatterns.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 14 4 | VisualStudioVersion = 14.0.23107.0 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{C9C12D81-FCF8-4909-93F3-A6B4EF361645}" 7 | ProjectSection(SolutionItems) = preProject 8 | paket.dependencies = paket.dependencies 9 | EndProjectSection 10 | EndProject 11 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharpReactivePatterns", "FSharpReactivePatterns.fsproj", "{D41A0698-C9E5-42FA-9DE7-97F8B2B9757B}" 12 | EndProject 13 | Global 14 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 15 | Debug|Any CPU = Debug|Any CPU 16 | Release|Any CPU = Release|Any CPU 17 | EndGlobalSection 18 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 19 | {D41A0698-C9E5-42FA-9DE7-97F8B2B9757B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 20 | {D41A0698-C9E5-42FA-9DE7-97F8B2B9757B}.Debug|Any CPU.Build.0 = Debug|Any CPU 21 | {D41A0698-C9E5-42FA-9DE7-97F8B2B9757B}.Release|Any CPU.ActiveCfg = Release|Any CPU 22 | {D41A0698-C9E5-42FA-9DE7-97F8B2B9757B}.Release|Any CPU.Build.0 = Release|Any CPU 23 | EndGlobalSection 24 | GlobalSection(SolutionProperties) = preSolution 25 | HideSolutionNode = FALSE 26 | EndGlobalSection 27 | EndGlobal 28 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /MessageConstruction/CommandMessage.fsx: -------------------------------------------------------------------------------- 1 | #load "../References.fsx" 2 | 3 | open Akka.FSharp 4 | 5 | let system = System.create "system" <| Configuration.load () 6 | 7 | type Money = Money of decimal 8 | type TradingCommand = 9 | | ExecuteBuyOrder of portfolioId: string * symbol: string * quantity: int * price: Money 10 | | ExecuteSellOrder of portfolioId: string * symbol: string * quantity: int * price: Money 11 | 12 | let stockTrader (mailbox: Actor<_>) = 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | match message with 16 | | ExecuteBuyOrder(portfolioId, symbol, quantity, price) as buy -> 17 | printfn "StockTrader: buying for: %A" buy 18 | | ExecuteSellOrder(portfolioId, symbol, quantity, price) as sell -> 19 | printfn "StockTrader: selling for: %A" sell 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let stockTraderRef = spawn system "stockTrader" <| stockTrader 25 | 26 | stockTraderRef ) = 14 | let quoterId = mailbox.Self.Path.Name 15 | let rec loop () = actor { 16 | let! RequestPriceQuote(rfqId, itemId, Money retailPrice, _) = mailbox.Receive () 17 | mailbox.Sender () ) = 23 | quotation ) = 15 | let quoterId = mailbox.Self.Path.Name 16 | let rec loop () = actor { 17 | let! RequestPriceQuote(rfqId, itemId, Money retailPrice, _) = mailbox.Receive () 18 | subscriber ) = 24 | let rec loop () = actor { 25 | let! message = mailbox.Receive () 26 | printfn "Requester: event %A" message 27 | return! loop () 28 | } 29 | loop () 30 | 31 | let subscriberRef = spawn system "subscriber" subscriber 32 | let quotationRef = spawn system "quotation" <| quotation subscriberRef 33 | 34 | quotationRef ) = 14 | let rec loop () = actor { 15 | let! message = mailbox.Receive () 16 | let orderExecutionStartedOn = match message.Version with 17 | | 1 -> Some DateTimeOffset.UtcNow 18 | | _ -> message.DateTimeOrdered 19 | printfn "StockTrader: orderExecutionStartedOn: %A" orderExecutionStartedOn 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let stockTraderRef = spawn system "stockTrader" stockTrader 25 | stockTraderRef int64) message) 16 | let timeToLive = (^a: (member get_TimeToLive: unit -> int64) message) 17 | let elapsed = currentTimeMillis () - occurredOn 18 | elapsed > timeToLive 19 | 20 | let purchaseRouter purchaseAgent (mailbox: Actor<_>) = 21 | let random = Random () 22 | let rec loop () = actor { 23 | let! message = mailbox.Receive () 24 | let millis = random.Next 100 + 1 25 | printfn "PurchaseRouter: delaying delivery of %A for %i milliseconds" message millis 26 | let duration = TimeSpan.FromMilliseconds <| float millis 27 | mailbox.Context.System.Scheduler.ScheduleTellOnce (duration, purchaseAgent, message) 28 | return! loop () 29 | } 30 | loop () 31 | 32 | let purchaseAgent (mailbox: Actor) = 33 | let rec loop () = actor { 34 | let! message = mailbox.Receive () 35 | if isExpired message then 36 | mailbox.Context.System.DeadLetters ) = 14 | let rec loop () = actor { 15 | let! message = mailbox.Receive () 16 | match message with 17 | | StartWith server -> 18 | printfn "Client: is starting..." 19 | server printfn "Client: received response: %s" what 21 | return! loop () 22 | } 23 | loop () 24 | 25 | let server (mailbox: Actor<_>) = 26 | let rec loop () = actor { 27 | let! Request what = mailbox.Receive () 28 | printfn "Server: received request value: %s" what 29 | mailbox.Sender () ) = 19 | let rec loop () = actor { 20 | let! message = mailbox.Receive () 21 | match message with 22 | | StartWith server -> 23 | printfn "Client: is starting..." 24 | server printfn "Client: received response: %s" what 27 | | ReplyToComplex what -> printfn "Client: received reply to complex: %s" what 28 | return! loop () 29 | } 30 | loop () 31 | 32 | let worker (mailbox: Actor<_>) = 33 | let rec loop () = actor { 34 | let! WorkerRequestComplex what = mailbox.Receive () 35 | printfn "Worker: received complex request value: %s" what 36 | mailbox.Sender () ) = 42 | let workerRef = spawn mailbox.Context "worker" worker 43 | let rec loop () = actor { 44 | let! message = mailbox.Receive () 45 | match message with 46 | | Request what -> 47 | printfn "Server: received request value: %s" what 48 | mailbox.Sender () 50 | printfn "Server: received request value: %s" what 51 | mailbox.Sender () ) = 10 | let rec loop () = actor { 11 | let! workItem = mailbox.Receive () 12 | printfn "%s for: %s" mailbox.Self.Path.Name workItem.Name 13 | return! loop () 14 | } 15 | loop () 16 | 17 | let workItemsProviderRef = spawnOpt system "workItemsProvider" workConsumer [ Router(Akka.Routing.SmallestMailboxPool(5)) ] 18 | 19 | [ 1 .. 100 ] 20 | |> List.iter (fun itemCount -> workItemsProviderRef Option.fold (fun _ text -> 16 | match text.ToLower () with 17 | | text when text.Contains "low" -> "Low" 18 | | text when text.Contains "medium" -> "Medium" 19 | | text when text.Contains "high" -> "High" 20 | | _ -> "Unknown") 21 | "Unknown" 22 | member this.IsNotAttached with get () = this.Text |> Option.fold (fun _ text -> String.IsNullOrEmpty text) false 23 | member this.IsDefined with get () = this.Text.IsSome 24 | 25 | let riskAssessment (mailbox: Actor<_>) = 26 | let rec documented (document: Document) = actor { 27 | let! message = mailbox.Receive () 28 | match message with 29 | | AttachDocument _ -> 30 | // already received; ignore 31 | return! documented document 32 | | ClassifyRisk -> 33 | mailbox.Sender () 40 | let document = { Text = Some documentText } 41 | return! documented document 42 | | ClassifyRisk -> 43 | mailbox.Sender () Async.RunSynchronously 51 | printfn "%A" futureAssessment1 52 | riskAssessmentRef Async.RunSynchronously 54 | printfn "%A" futureAssessment2 -------------------------------------------------------------------------------- /MessageEndpoints/IdempotentReceiverDeduplication.fsx: -------------------------------------------------------------------------------- 1 | #load "../References.fsx" 2 | 3 | open Akka.FSharp 4 | 5 | let system = System.create "system" <| Configuration.load () 6 | 7 | type AccountId = AccountId of string 8 | type TransactionId = TransactionId of string 9 | type Money = Money of decimal 10 | type Transaction = Transaction of transactionId: TransactionId * amount: Money 11 | type AccountBalance = AccountBalance of accountId: AccountId * amount: Money 12 | type AccountMessage = 13 | | Deposit of transactionId: TransactionId * amount: Money 14 | | Withdraw of transactionId: TransactionId * amount: Money 15 | | QueryBalance 16 | 17 | let account accountId (mailbox: Actor<_>) = 18 | let rec loop transactions = actor { 19 | let calculateBalance () = 20 | let amount = 21 | transactions 22 | |> Map.toList 23 | |> List.sumBy (fun (_,Transaction(_, Money amount)) -> amount) 24 | printfn "Balance: %M" amount 25 | AccountBalance(accountId, Money amount) 26 | 27 | let! message = mailbox.Receive () 28 | match message with 29 | | Deposit(transactionId, amount) -> 30 | let transaction = Transaction(transactionId, amount) 31 | printfn "Deposit: %A" transaction 32 | return! loop (transactions |> Map.add transactionId transaction) 33 | | Withdraw(transactionId, Money amount) -> 34 | let transaction = Transaction(transactionId, Money -amount) 35 | printfn "Withdraw: %A" transaction 36 | return! loop (transactions |> Map.add transactionId transaction) 37 | | QueryBalance -> 38 | mailbox.Sender () ) = 10 | let rec loop () = actor { 11 | let! workItem = mailbox.Receive () 12 | printfn "%s for: %s" mailbox.Self.Path.Name workItem.Name 13 | return! loop () 14 | } 15 | loop () 16 | 17 | let workItemsProvider = spawnOpt system "workItemsProvider" workConsumer [ Router(Akka.Routing.RoundRobinPool(5)) ] 18 | 19 | workItemsProvider ) = 18 | let rec loop amount = actor { 19 | let! message = mailbox.Receive () 20 | match message with 21 | | InitializeOrder amount -> 22 | printfn "Initializing Order with %M" amount 23 | return! loop amount 24 | | ProcessOrder -> 25 | printfn "Processing Order is %A" message 26 | return! loop amount 27 | } 28 | loop 0m 29 | 30 | let aggregateCache aggregateFunc (mailbox: Actor<_>) = 31 | let rec loop aggregateIds = actor { 32 | let! CacheMessage(id, actualMessage, sender) = mailbox.Receive () 33 | let child = mailbox.Context.Child id 34 | let aggregate = if child = (ActorRefs.Nobody :> IActorRef) then spawn mailbox.Context id <| aggregateFunc // reconstitute aggregate state here if pre-existing 35 | else child 36 | aggregate.Tell (actualMessage, sender) 37 | return! loop aggregateIds 38 | } 39 | loop Set.empty 40 | 41 | type DomainModel(name) = 42 | let mutable aggregateTypeRegistry = Map.empty 43 | let system = System.create "system" <| Configuration.load () 44 | member this.AggregateOf (typeName, id) = 45 | let (AggregateType cacheActor) = aggregateTypeRegistry |> Map.find typeName 46 | cacheActor Map.add typeName (AggregateType actorRef) 51 | member this.Shutdown () = system.Shutdown () 52 | 53 | let orderType = "Order" 54 | let model = DomainModel("OrderProcessing") 55 | model.RegisterAggregateType (orderType, order) 56 | let orderRef = model.AggregateOf (orderType, "123") 57 | 58 | orderRef string 14 | abstract member Deserialize: string -> 'a 15 | 16 | let serializer = { 17 | new IMessageSerializer with 18 | member this.Serialize obj = JsonConvert.SerializeObject obj 19 | member this.Deserialize json = JsonConvert.DeserializeObject<'a>(json) 20 | } 21 | 22 | let orderQueryService (serializer: IMessageSerializer) (mailbox: Actor<_>) = 23 | let monthlyOrdersFor customerId = [ for i in [1 .. 10] -> sprintf "Order data %i" i ] 24 | let rec loop () = actor { 25 | let! QueryMonthlyOrdersFor(customerId) as message = mailbox.Receive () 26 | printfn "OrderQueryService: Received %A" message 27 | let queryResult = monthlyOrdersFor customerId 28 | let messageBody = serializer.Serialize(queryResult) 29 | mailbox.Sender () ) = 35 | orderQueryService ) = 18 | let rec loop workItemsNamed = actor { 19 | let allocateWorkItems numberOfItems = 20 | let allocatedWorkItems = 21 | [ 1 .. numberOfItems ] 22 | |> List.map (fun itemCount -> 23 | let nameIndex = workItemsNamed + itemCount 24 | { Name = "WorkItem" + nameIndex.ToString () }) 25 | allocatedWorkItems, workItemsNamed + numberOfItems 26 | 27 | let! AllocateWorkItems numberOfItems = mailbox.Receive () 28 | let allocatedWorkItems, workItemsNamed = allocateWorkItems(numberOfItems) 29 | mailbox.Sender () ) = 35 | mailbox.Defer (fun () -> mailbox.Context.Stop(workItemsProvider)) 36 | let rec loop totalItemsWorkedOn = actor { 37 | let performWorkOn workItem = 38 | let totalItemsWorkedOn = totalItemsWorkedOn + 1 39 | if (totalItemsWorkedOn >= 15) then mailbox.Context.Stop mailbox.Self else () 40 | totalItemsWorkedOn 41 | 42 | let! message = mailbox.Receive () 43 | match message with 44 | | WorkItemsAllocated workitems -> 45 | printfn "WorkItemsAllocated..." 46 | workitems |> List.iter (fun workItem -> mailbox.Self 50 | printfn "WoorkNeeded..." 51 | workItemsProvider 54 | printfn "Performed work on: %s" workItem.Name 55 | let totalItemsWorkedOn = performWorkOn workItem 56 | return! loop totalItemsWorkedOn 57 | } 58 | loop 0 59 | 60 | let workItemsProviderRef = spawn system "workItemsProvider" workItemsProvider 61 | let workConsumerRef = spawn system "workConsumer" <| workConsumer workItemsProviderRef 62 | 63 | workConsumerRef ) = 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | match box message with 16 | | :? MessageTypeA -> 17 | consumerOfA.Forward message 18 | return! loop () 19 | | :? MessageTypeB -> 20 | consumerOfB.Forward message 21 | return! loop () 22 | | :? MessageTypeC -> 23 | consumerOfC.Forward message 24 | return! loop () 25 | | _ -> return! loop () 26 | } 27 | loop () 28 | 29 | let consumerOfMessageTypeA (mailbox: Actor<_>) = 30 | let rec loop () = actor { 31 | let! message = mailbox.Receive () 32 | printfn "ConsumerOfMessageTypeA: %A" message 33 | return! loop () 34 | } 35 | loop () 36 | 37 | let consumerOfMessageTypeB (mailbox: Actor<_>) = 38 | let rec loop () = actor { 39 | let! message = mailbox.Receive () 40 | printfn "ConsumerOfMessageTypeB: %A" message 41 | return! loop () 42 | } 43 | loop () 44 | 45 | let consumerOfMessageTypeC (mailbox: Actor<_>) = 46 | let rec loop () = actor { 47 | let! message = mailbox.Receive () 48 | printfn "ConsumerOfMessageTypeC: %A" message 49 | return! loop () 50 | } 51 | loop () 52 | 53 | let consumerOfARef = spawn system "consumerOfA" consumerOfMessageTypeA 54 | let consumerOfBRef = spawn system "consumerOfB" consumerOfMessageTypeB 55 | let consumerOfCRef = spawn system "consumerOfC" consumerOfMessageTypeC 56 | let selectiveConsumerRef = spawn system "selectiveConsumer" <| selectiveConsumer consumerOfARef consumerOfBRef consumerOfCRef 57 | 58 | selectiveConsumerRef List.sumBy (fun i -> i.RetailPrice) 13 | type RequestPriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; OrderTotalRetailPrice: Money } 14 | type PriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; DiscountPrice: Money } 15 | type AggregatorMessage = 16 | | PriceQuoteFulfilled of PriceQuote 17 | | RequiredPriceQuotesForFulfillment of rfqId: string * quotesRequested: int 18 | type QuotationFulfillment = { RfqId: string; QuotesRequested: int; PriceQuotes: PriceQuote list; Requester: IActorRef } 19 | 20 | let priceQuoteAggregator (mailbox: Actor<_>) = 21 | let rec loop fulfilledPriceQuotes = actor { 22 | let! message = mailbox.Receive () 23 | match message with 24 | | RequiredPriceQuotesForFulfillment(rfqId, quotesRequested) as message -> 25 | printfn "PriceQuoteAggregator: required fulfilled: %A" message 26 | return! loop (fulfilledPriceQuotes |> Map.add rfqId ({RfqId = rfqId; QuotesRequested = quotesRequested; PriceQuotes = []; Requester = mailbox.Sender () })) 27 | | PriceQuoteFulfilled priceQuoteFulfilled -> 28 | printfn "PriceQuoteAggregator: fulfilled price quote: %A" priceQuoteFulfilled 29 | let previousFulfillment = fulfilledPriceQuotes |> Map.find priceQuoteFulfilled.RfqId 30 | let currentPriceQuotes = previousFulfillment.PriceQuotes @ [priceQuoteFulfilled] 31 | let currentFulfillment = { previousFulfillment with PriceQuotes = currentPriceQuotes } 32 | if (currentPriceQuotes.Length >= currentFulfillment.QuotesRequested) then 33 | currentFulfillment.Requester Map.remove priceQuoteFulfilled.RfqId) 35 | else return! loop (fulfilledPriceQuotes |> Map.add priceQuoteFulfilled.RfqId currentFulfillment) 36 | } 37 | loop Map.empty 38 | 39 | let mountaineeringSuppliesOrderProcessor priceQuoteAggregator (mailbox: Actor<_>) = 40 | let rec loop interestRegistry = actor { 41 | let calculateRecipientList (rfq: RequestForQuotation) = 42 | interestRegistry 43 | |> Map.toList 44 | |> List.filter (fun (_, v) -> 45 | let (Money lowTotalRetail) = v.LowTotalRetail 46 | let (Money highTotalRetail) = v.HighTotalRetail 47 | rfq.TotalRetailPrice >= lowTotalRetail && rfq.TotalRetailPrice <= highTotalRetail) 48 | |> List.map (fun (_, v) -> v.QuoteProcessor) 49 | 50 | let dispatchTo rfq (recipientList: IActorRef list) = 51 | recipientList 52 | |> List.iter (fun recipient -> 53 | rfq.RetailItems 54 | |> List.iter (fun retailItem -> 55 | printfn "OrderProcessor: %s item: %s to: %s" rfq.RfqId retailItem.ItemId <| recipient.Path.ToString () 56 | recipient return! loop <| Map.add interest.Path interest interestRegistry 61 | | :? PriceQuote as priceQuote -> 62 | priceQuoteAggregator 65 | let recipientList = calculateRecipientList rfq 66 | priceQuoteAggregator printfn "OrderProcessor: received: %A" fulfillment 69 | | message -> printfn "OrderProcessor: unexpected: %A" message 70 | return! loop interestRegistry 71 | } 72 | loop Map.empty 73 | 74 | let budgetHikersPriceQuotes interestRegistrar (mailbox: Actor) = 75 | interestRegistrar ) = 95 | interestRegistrar ) = 115 | interestRegistrar ) = 137 | interestRegistrar ) = 160 | interestRegistrar } 10 | type OrderPlaced = OrderPlaced of Order 11 | 12 | let inventorySystemA (mailbox: Actor<_>) = 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | printfn "InventorySystemA: handling %A" message 16 | return! loop () 17 | } 18 | loop () 19 | 20 | let inventorySystemX (mailbox: Actor<_>) = 21 | let rec loop () = actor { 22 | let! message = mailbox.Receive () 23 | printfn "InventorySystemX: handling %A" message 24 | return! loop () 25 | } 26 | loop () 27 | 28 | let orderRouter (mailbox: Actor<_>) = 29 | let inventorySystemA = spawn mailbox.Context "inventorySystemA" inventorySystemA 30 | let inventorySystemX = spawn mailbox.Context "inventorySystemX" inventorySystemX 31 | 32 | let rec loop () = actor { 33 | let! orderPlaced = mailbox.Receive () 34 | let (OrderPlaced order) = orderPlaced 35 | match order.OrderType with 36 | | "TypeABC" -> 37 | printfn "OrderRouter: routing %A" orderPlaced 38 | inventorySystemA 40 | printfn "OrderRouter: routing %A" orderPlaced 41 | inventorySystemX printfn "OrderRouter: received unexpected message" 43 | return! loop () 44 | } 45 | loop () 46 | 47 | let orderRouterRef = spawn system "orderRouter" orderRouter 48 | 49 | let orderItem1 = { Id = "1"; ItemType = "TypeABC.4"; Description = "An item of type ABC.4."; Price = 29.95m } 50 | let orderItem2 = { Id = "2"; ItemType = "TypeABC.1"; Description = "An item of type ABC.1."; Price = 99.95m } 51 | let orderItem3 = { Id = "3"; ItemType = "TypeABC.9"; Description = "An item of type ABC.9."; Price = 14.95m } 52 | let orderItemsOfTypeA = Map.ofList [(orderItem1.ItemType, orderItem1); (orderItem2.ItemType, orderItem2); (orderItem3.ItemType, orderItem3)] 53 | orderRouterRef ) = 18 | interestRouter .Name) 19 | 20 | let rec loop () = actor { 21 | let! message = mailbox.Receive () 22 | printfn "TypeAInterested: received: %A" message 23 | return! loop () 24 | } 25 | loop () 26 | 27 | let typeBInterested interestRouter (mailbox: Actor) = 28 | interestRouter .Name) 29 | 30 | let rec loop () = actor { 31 | let! message = mailbox.Receive () 32 | printfn "TypeBInterested: received: %A" message 33 | return! loop () 34 | } 35 | loop () 36 | 37 | let typeCInterested interestRouter (mailbox: Actor) = 38 | interestRouter .Name) 39 | 40 | let rec loop () = actor { 41 | let! message = mailbox.Receive () 42 | printfn "TypeCInterested: received: %A" message 43 | interestRouter .Name) 44 | return! loop () 45 | } 46 | loop () 47 | 48 | let typeCAlsoInterested interestRouter (mailbox: Actor) = 49 | interestRouter .Name) 50 | 51 | let rec loop () = actor { 52 | let! message = mailbox.Receive () 53 | printfn "TypeCAlsoInterested: received: %A" message 54 | interestRouter .Name) 55 | return! loop () 56 | } 57 | loop () 58 | 59 | let dunnoInterested (mailbox: Actor<_>) = 60 | let rec loop () = actor { 61 | let! message = mailbox.Receive () 62 | printfn "DunnoInterest: received undeliverable message: %A" message 63 | return! loop () 64 | } 65 | loop () 66 | 67 | let typedMessageInterestRouter dunnoInterested (mailbox: Actor<_>) = 68 | let rec loop (interestRegistry: Map) (secondaryInterestRegistry: Map) = actor { 69 | let registerInterest messageType interested = 70 | interestRegistry 71 | |> Map.tryFind messageType 72 | |> Option.fold 73 | (fun _ _ -> interestRegistry, Map.add messageType interested secondaryInterestRegistry) 74 | (Map.add messageType interested interestRegistry, secondaryInterestRegistry) 75 | 76 | let unregisterInterest messageType wasInterested = 77 | interestRegistry 78 | |> Map.tryFind messageType 79 | |> Option.bind (fun i -> if i = wasInterested then Some (Map.remove messageType interestRegistry, secondaryInterestRegistry) else None) 80 | |> Option.bind (fun (p,s) -> s |> Map.tryFind messageType |> Option.map(fun i -> Map.add messageType i p, Map.remove messageType secondaryInterestRegistry)) 81 | |> Option.fold (fun _ i -> i) (interestRegistry, secondaryInterestRegistry) 82 | 83 | let sendFor message = 84 | let messageType = (message.GetType ()).Name 85 | interestRegistry 86 | |> Map.tryFind messageType 87 | |> Option.fold (fun _ i -> i) dunnoInterested 88 | |> fun i -> i 93 | match r with 94 | | InterestedIn messageType -> return! loop <|| registerInterest messageType (mailbox.Sender ()) 95 | | NoLongerInterestedIn messageType -> return! loop <|| unregisterInterest messageType (mailbox.Sender ()) 96 | | message -> 97 | sendFor message 98 | return! loop interestRegistry secondaryInterestRegistry 99 | } 100 | loop Map.empty Map.empty 101 | 102 | let dunnoInterestedRef = spawn system "dunnoInterested" dunnoInterested 103 | let typedMessageInterestRouterRef = spawn system "typedMessageInterestRouter" <| typedMessageInterestRouter dunnoInterestedRef 104 | let typeAInterestedRef = spawn system "typeAInterest" <| typeAInterested typedMessageInterestRouterRef 105 | let typeBInterestedRef = spawn system "typeBInterest" <| typeBInterested typedMessageInterestRouterRef 106 | let typeCInterestedRef = spawn system "typeCInterest" <| typeCInterested typedMessageInterestRouterRef 107 | let typeCAlsoInterestedRef = spawn system "typeCAlsoInterested" <| typeCAlsoInterested typedMessageInterestRouterRef 108 | 109 | typedMessageInterestRouterRef } 11 | type OrderPlaced = OrderPlaced of Order 12 | 13 | let inventorySystemA (mailbox: Actor<_>) = 14 | let rec loop () = actor { 15 | let! message = mailbox.Receive () 16 | printfn "InventorySystemA: handling %A" message 17 | return! loop () 18 | } 19 | loop () 20 | 21 | let inventorySystemX (mailbox: Actor<_>) = 22 | let rec loop () = actor { 23 | let! message = mailbox.Receive () 24 | printfn "InventorySystemX: handling %A" message 25 | return! loop () 26 | } 27 | loop () 28 | 29 | let inventorySystemXMessageFilter (actualInventorySystemX: IActorRef) (mailbox: Actor<_>) = 30 | let rec loop () = actor { 31 | let! orderPlaced = mailbox.Receive () 32 | let (OrderPlaced order) = orderPlaced 33 | match order.OrderType with 34 | | "TypeABC" -> actualInventorySystemX.Forward orderPlaced 35 | | _ -> printfn "InventorySystemXMessageFilter: filtering: %A" orderPlaced 36 | return! loop () 37 | } 38 | loop () 39 | 40 | let inventorySystemARef = spawn system "inventorySystemA" inventorySystemA 41 | let actualInventorySystemXRef = spawn system "inventorySystemX" inventorySystemX 42 | let inventorySystemXRef = spawn system "inventorySystemXMessageFilter" <| inventorySystemXMessageFilter actualInventorySystemXRef 43 | 44 | let orderItem1 = { Id = "1"; ItemType = "TypeABC.4"; Description = "An item of type ABC.4."; Price = 29.95m } 45 | let orderItem2 = { Id = "2"; ItemType = "TypeABC.1"; Description = "An item of type ABC.1."; Price = 99.95m } 46 | let orderItem3 = { Id = "3"; ItemType = "TypeABC.9"; Description = "An item of type ABC.9."; Price = 14.95m } 47 | let orderItemsOfTypeA = Map.ofList [(orderItem1.ItemType, orderItem1); (orderItem2.ItemType, orderItem2); (orderItem3.ItemType, orderItem3)] 48 | inventorySystemARef Map.find processId 34 | let startProcess processId ``process`` self processes = 35 | self Map.add processId ``process`` 37 | let stopProcess processId self processes = 38 | let ``process`` = processOf processId processes 39 | self Map.remove processId 41 | 42 | let loanRateQuote loanRateQuoteId taxId amount termInMonths loanBroker (mailbox: Actor<_>) = 43 | let rec loop bankLoanRateQuotes expectedLoanRateQuotes creditRatingScore = actor { 44 | let quotableCreditScore score = score > 399 45 | 46 | let bestBankLoanRateQuote () = bankLoanRateQuotes |> List.minBy (fun bankLoanRateQuote -> bankLoanRateQuote.InterestRate) 47 | 48 | let! message = mailbox.Receive () 49 | match message with 50 | | StartLoanRateQuote expectedLoanRateQuotes -> 51 | loanBroker 54 | if quotableCreditScore creditRatingScore then loanBroker 58 | let bankLoanRateQuote = { BankId = bankId; BankLoanRateQuoteId = bankLoanRateQuoteId; InterestRate = interestRate } 59 | loanBroker List.length >= expectedLoanRateQuotes then loanBroker 64 | loanBroker ) = 70 | let rec loop processes = actor { 71 | let! message = mailbox.Receive () 72 | match message with 73 | | BankLoanRateQuoted(bankId, bankLoanRateQuoteId, loadQuoteReferenceId, taxId, interestRate) -> 74 | printfn "%A" message 75 | Process.processOf loadQuoteReferenceId processes 78 | printfn "%A" message 79 | Process.processOf creditProcessingReferenceId processes 82 | printfn "%A" message 83 | Process.processOf loanRateQuoteId processes 88 | printfn "%A" message 89 | banks |> List.iter (fun bank -> bank 92 | printfn "%A" message 93 | let best = BestLoanRateQuoted(bestBankLoanRateQuote.BankId, loanRateQuoteId, taxId, amount, termInMonths, creditScore, bestBankLoanRateQuote.InterestRate) 94 | printfn "Would be sent to original requester: %A" best 95 | return! loop <| Process.stopProcess loanRateQuoteId mailbox.Self processes 96 | | LoanRateQuoteRecorded(loanRateQuoteId, taxId, bankLoanRateQuote) -> 97 | printfn "%A" message 98 | return! loop processes 99 | | LoanRateQuoteStarted(loanRateQuoteId, taxId) -> 100 | printfn "%A" message 101 | creditBureau 104 | printfn "%A" message 105 | return! loop <| Process.stopProcess loanRateQuoteId mailbox.Self processes 106 | | ProcessStarted(processId, ``process``) -> 107 | printfn "%A" message 108 | ``process`` printfn "%A" message 111 | | QuoteBestLoanRate(taxId, amount, termInMonths) -> 112 | let loanRateQuoteId = (Guid.NewGuid ()).ToString () // LoanRateQuote.id 113 | let loanRateQuote = spawn mailbox.Context "loanRateQuote" <| loanRateQuote loanRateQuoteId taxId amount termInMonths mailbox.Self 114 | return! loop <| Process.startProcess loanRateQuoteId loanRateQuote mailbox.Self processes 115 | } 116 | loop Map.empty 117 | 118 | let creditBureau (mailbox: Actor<_>) = 119 | let creditRanges = [300; 400; 500; 600; 700] 120 | let randomCreditRangeGenerator = Random() 121 | let randomCreditScoreGenerator = Random() 122 | 123 | let rec loop () = actor { 124 | let! (CheckCredit(creditProcessingReferenceId, taxId)) = mailbox.Receive () 125 | let range = creditRanges |> List.item (randomCreditRangeGenerator.Next 5) 126 | let score = range + randomCreditScoreGenerator.Next 20 127 | mailbox.Sender () ) = 133 | let randomDiscount = Random() 134 | let randomQuoteId = Random() 135 | let calculateInterestRate amount months creditScore = 136 | let creditScoreDiscount = creditScore / 100.0m / 10.0m - ((randomDiscount.Next 5 |> decimal) * 0.05m) 137 | primeRate + ratePremium + ((months / 12.0m) / 10.0m) - creditScoreDiscount 138 | 139 | let rec loop () = actor { 140 | let! (QuoteLoanRate(loadQuoteReferenceId, taxId, creditScore, amount, termInMonths)) = mailbox.Receive () 141 | let interestRate = calculateInterestRate amount (decimal termInMonths) (decimal creditScore) 142 | mailbox.Sender () List.sumBy (fun i -> i.RetailPrice) 13 | type RequestPriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; OrderTotalRetailPrice: Money } 14 | type PriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; DiscountPrice: Money } 15 | 16 | let mountaineeringSuppliesOrderProcessor (mailbox: Actor<_>) = 17 | let rec loop interestRegistry = actor { 18 | let calculateRecipientList (rfq: RequestForQuotation) = 19 | interestRegistry 20 | |> Map.toList 21 | |> List.filter (fun (_, v) -> 22 | let (Money lowTotalRetail) = v.LowTotalRetail 23 | let (Money highTotalRetail) = v.HighTotalRetail 24 | rfq.TotalRetailPrice >= lowTotalRetail && rfq.TotalRetailPrice <= highTotalRetail) 25 | |> List.map (fun (_, v) -> v.QuoteProcessor) 26 | 27 | let dispatchTo rfq (recipientList: IActorRef list) = 28 | recipientList 29 | |> List.iter (fun recipient -> 30 | rfq.RetailItems 31 | |> List.iter (fun retailItem -> 32 | printfn "OrderProcessor: %s item: %s to: %s" rfq.RfqId retailItem.ItemId <| recipient.Path.ToString () 33 | recipient return! loop <| Map.add interest.Path interest interestRegistry 38 | | :? PriceQuote as priceQuote -> printfn "OrderProcessor: received: %A" priceQuote 39 | | :? RequestForQuotation as rfq -> 40 | let recipientList = calculateRecipientList rfq 41 | dispatchTo rfq recipientList 42 | | message -> printfn "OrderProcessor: unexpected: %A" message 43 | return! loop interestRegistry 44 | } 45 | loop Map.empty 46 | 47 | let budgetHikersPriceQuotes interestRegistrar (mailbox: Actor) = 48 | interestRegistrar ) = 68 | interestRegistrar ) = 88 | interestRegistrar ) = 110 | interestRegistrar ) = 133 | interestRegistrar ) = 14 | let random = Random() 15 | let rec loop () = actor { 16 | let! SequencedMessage(correlationId, index, total) as sequencedMessage = mailbox.Receive () 17 | let millis = random.Next 100 18 | printfn "ChaosRouter: delaying delivery of %A for %i milliseconds" sequencedMessage millis 19 | let duration = TimeSpan.FromMilliseconds (float millis) 20 | mailbox.Context.System.Scheduler.ScheduleTellOnce (duration, consumer, sequencedMessage) 21 | return! loop () 22 | } 23 | loop () 24 | 25 | let resequencerConsumer actualConsumer (mailbox: Actor<_>) = 26 | let rec loop resequenced = actor { 27 | let dummySequencedMessages count = [| for _ in 1 .. count -> SequencedMessage("", -1, count) |] 28 | 29 | let resequence sequencedMessage resequenced = 30 | let (SequencedMessage(correlationId, index, total)) = sequencedMessage 31 | let resequenced = 32 | resequenced 33 | |> Map.tryFind correlationId 34 | |> Option.fold 35 | (fun _ v -> resequenced) 36 | (resequenced |> Map.add correlationId ( { DispatchableIndex = 1; SequencedMessages = dummySequencedMessages total })) 37 | resequenced 38 | |> Map.find correlationId 39 | |> fun m -> m.SequencedMessages.[index - 1] <- sequencedMessage 40 | resequenced 41 | 42 | let rec dispatchAllSequenced correlationId resequenced = 43 | let resequencedMessage = resequenced |> Map.find correlationId 44 | let dispatchableIndex = 45 | resequencedMessage.SequencedMessages 46 | |> Array.filter (fun (SequencedMessage(_, index, _) as sequencedMessage) -> index = resequencedMessage.DispatchableIndex) 47 | |> Array.fold (fun dispatchableIndex sequencedMessage -> 48 | actualConsumer Map.add correlationId (resequencedMessage.AdvancedTo dispatchableIndex) 52 | if resequencedMessage.SequencedMessages |> Array.exists (fun (SequencedMessage(_, index, _)) -> index = dispatchableIndex) then dispatchAllSequenced correlationId resequenced 53 | else resequenced 54 | 55 | let removeCompleted correlationId resequenced = 56 | resequenced 57 | |> Map.find correlationId 58 | |> fun resequencedMessages -> 59 | let (SequencedMessage(_,_,total)) = resequencedMessages.SequencedMessages.[0] 60 | if resequencedMessages.DispatchableIndex > total then 61 | printfn "ResequencerConsumer: removed completed: %s" correlationId 62 | resequenced |> Map.remove correlationId 63 | else resequenced 64 | 65 | let! SequencedMessage(correlationId, index, total) as unsequencedMessage = mailbox.Receive () 66 | printfn "ResequencerConsumer: received: %A" unsequencedMessage 67 | let resequenced = 68 | resequenced 69 | |> resequence unsequencedMessage 70 | |> dispatchAllSequenced correlationId 71 | |> removeCompleted correlationId 72 | return! loop resequenced 73 | } 74 | loop Map.empty 75 | 76 | let sequencedMessageConsumer (mailbox: Actor) = 77 | let rec loop () = actor { 78 | let! sequencedMessage = mailbox.Receive () 79 | printfn "SequencedMessageConsumer: received: %A" sequencedMessage 80 | return! loop () 81 | } 82 | loop () 83 | 84 | let sequencedMessageConsumerRef = spawn system "sequencedMessageConsumer" sequencedMessageConsumer 85 | let resequencerConsumerRef = spawn system "resequencerConsumer" <| resequencerConsumer sequencedMessageConsumerRef 86 | let chaosRouterRef = spawn system "chaosRouter" <| chaosRouter resequencerConsumerRef 87 | 88 | [1 .. 5] |> List.iter (fun index -> chaosRouterRef List.iter (fun index -> chaosRouterRef = this.ProcessSteps.Length 19 | member this.NextStep () = 20 | if (this.IsCompleted) then failwith "Process had already completed." 21 | else this.ProcessSteps |> List.item this.CurrentStep 22 | member this.StepCompleted () = { this with CurrentStep = this.CurrentStep + 1 } 23 | type RegisterCustomer = { RegistrationData: RegistrationData; RegistrationProcess: RegistrationProcess } with 24 | member this.Advance () = 25 | let advancedProcess = this.RegistrationProcess.StepCompleted () 26 | if not advancedProcess.IsCompleted then (advancedProcess.NextStep ()).Processor ) = 30 | let rec loop () = actor { 31 | let! registerCustomer = mailbox.Receive () 32 | let federalTaxId = registerCustomer.RegistrationData.CustomerInformation.FederalTaxId 33 | printfn "CreditChecker: handling register customer to perform credit check: %s" federalTaxId 34 | registerCustomer.Advance () 35 | } 36 | loop () 37 | 38 | let contactKeeper (mailbox: Actor<_>) = 39 | let rec loop () = actor { 40 | let! registerCustomer = mailbox.Receive () 41 | let contactInfo = registerCustomer.RegistrationData.ContactInformation 42 | printfn "ContactKeeper: handling register customer to keep contact information: %A" contactInfo 43 | registerCustomer.Advance () 44 | } 45 | loop () 46 | 47 | let customerVault (mailbox: Actor<_>) = 48 | let rec loop () = actor { 49 | let! registerCustomer = mailbox.Receive () 50 | let customerInformation = registerCustomer.RegistrationData.CustomerInformation 51 | printfn "CustomerVault: handling register customer to create a new custoner: %A" customerInformation 52 | registerCustomer.Advance () 53 | } 54 | loop () 55 | 56 | let servicePlanner (mailbox: Actor<_>) = 57 | let rec loop () = actor { 58 | let! registerCustomer = mailbox.Receive () 59 | let serviceOption = registerCustomer.RegistrationData.ServiceOption 60 | printfn "ServicePlanner: handling register customer to plan a new customer service: %A" serviceOption 61 | registerCustomer.Advance () 62 | } 63 | loop () 64 | 65 | module ServiceRegistry = 66 | let contactKeeper (system: ActorSystem) (id: string) = spawn system (sprintf "contactKeeper-%s" id) contactKeeper 67 | let creditChecker (system: ActorSystem) (id: string) = spawn system (sprintf "creditChecker-%s" id) creditChecker 68 | let customerVault (system: ActorSystem) (id: string) = spawn system (sprintf "customerVault-%s" id) customerVault 69 | let servicePlanner (system: ActorSystem) (id: string) = spawn system (sprintf "servicePlanner-%s" id) servicePlanner 70 | 71 | let processId = (Guid.NewGuid ()).ToString () 72 | let step1 = { Name = "create_customer"; Processor = ServiceRegistry.customerVault system processId } 73 | let step2 = { Name = "set_up_contact_info"; Processor = ServiceRegistry.contactKeeper system processId } 74 | let step3 = { Name = "select_service_plan"; Processor = ServiceRegistry.servicePlanner system processId } 75 | let step4 = { Name = "check_credit"; Processor = ServiceRegistry.creditChecker system processId } 76 | let registrationProcess = RegistrationProcess.Create (processId, [ step1; step2; step3; step4 ]) 77 | let registrationData = { 78 | CustomerInformation = { Name = "ABC, Inc."; FederalTaxId = "123-45-6789" } 79 | ContactInformation = { PostalAddress = { Address1 = "123 Main Street"; Address2 = "Suite 100"; City = "Boulder"; State = "CO"; ZipCode = "80301" } 80 | Telephone = Telephone "303-555-1212" } 81 | ServiceOption = { Id = "99-1203"; Description = "A description of 99-1203." } } 82 | let registerCustomer = { RegistrationData = registrationData; RegistrationProcess = registrationProcess } 83 | 84 | (registrationProcess.NextStep ()).Processor List.sumBy (fun i -> i.RetailPrice) 13 | type RequestPriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; OrderTotalRetailPrice: Money } 14 | type PriceQuote = { RfqId: string; ItemId: string; RetailPrice: Money; DiscountPrice: Money } 15 | type AggregatorMessage = 16 | | PriceQuoteFulfilled of PriceQuote 17 | | PriceQuoteTimedOut of rfqId: string 18 | | RequiredPriceQuotesForFulfillment of rfqId: string * quotesRequested: int 19 | type QuotationFulfillment = { RfqId: string; QuotesRequested: int; PriceQuotes: PriceQuote list; Requester: IActorRef } 20 | type BestPriceQuotation = { RfqId: string; PriceQuotes: PriceQuote list } 21 | type SubscribeToPriceQuoteRequests = SubscribeToPriceQuoteRequests of quoterId: string * quoteProcessor: IActorRef 22 | 23 | let priceQuoteAggregator (mailbox: Actor<_>) = 24 | let rec loop fulfilledPriceQuotes = actor { 25 | let bestPriceQuotationFrom (quotationFulfillment: QuotationFulfillment) = 26 | let bestPrices = 27 | quotationFulfillment.PriceQuotes 28 | |> List.groupBy (fun priceQuote -> priceQuote.ItemId) 29 | |> List.map (fun (itemId, quotes) -> 30 | quotes 31 | |> List.maxBy (fun quote -> 32 | let (Money discount) = quote.DiscountPrice 33 | discount)) 34 | { RfqId = quotationFulfillment.RfqId; PriceQuotes = bestPrices } 35 | 36 | let quoteBestPrice (quotationFulfillment: QuotationFulfillment) = 37 | fulfilledPriceQuotes 38 | |> Map.tryFind quotationFulfillment.RfqId 39 | |> Option.map (fun q -> quotationFulfillment.Requester Option.fold (fun _ _ -> fulfilledPriceQuotes |> Map.remove quotationFulfillment.RfqId) fulfilledPriceQuotes 41 | 42 | let priceQuoteRequestTimedOut rfqId = 43 | fulfilledPriceQuotes 44 | |> Map.tryFind rfqId 45 | |> Option.fold (fun _ _ -> quoteBestPrice (fulfilledPriceQuotes |> Map.find rfqId)) fulfilledPriceQuotes 46 | 47 | let priceQuoteRequestFulfilled (priceQuoteFulfilled: PriceQuote) = 48 | let previousFulfillment = fulfilledPriceQuotes |> Map.find priceQuoteFulfilled.RfqId 49 | let currentPriceQuotes = previousFulfillment.PriceQuotes @ [priceQuoteFulfilled] 50 | let currentFulfillment = { previousFulfillment with PriceQuotes = currentPriceQuotes } 51 | if (currentPriceQuotes.Length >= currentFulfillment.QuotesRequested) then quoteBestPrice currentFulfillment 52 | else fulfilledPriceQuotes |> Map.add priceQuoteFulfilled.RfqId currentFulfillment 53 | 54 | let! message = mailbox.Receive () 55 | match message with 56 | | RequiredPriceQuotesForFulfillment(rfqId, quotesRequested) as message -> 57 | printfn "PriceQuoteAggregator: required fulfilled: %A" message 58 | let duration = TimeSpan.FromSeconds 2. 59 | mailbox.Context.System.Scheduler.ScheduleTellOnce (duration, mailbox.Self, PriceQuoteTimedOut rfqId) 60 | return! loop (fulfilledPriceQuotes |> Map.add rfqId ({RfqId = rfqId; QuotesRequested = quotesRequested; PriceQuotes = []; Requester = mailbox.Sender () })) 61 | | PriceQuoteFulfilled priceQuote -> 62 | printfn "PriceQuoteAggregator: fulfilled price quote: %A" priceQuote 63 | return! loop <| priceQuoteRequestFulfilled priceQuote 64 | | PriceQuoteTimedOut rfqId -> return! loop <| priceQuoteRequestTimedOut rfqId 65 | } 66 | loop Map.empty 67 | 68 | let mountaineeringSuppliesOrderProcessor priceQuoteAggregator (mailbox: Actor<_>) = 69 | let rec loop subscribers = actor { 70 | let dispatch rfq = 71 | subscribers 72 | |> Map.toList 73 | |> List.iter (fun (_, (SubscribeToPriceQuoteRequests(quoterId, quoteProcessor) as subscriber)) -> 74 | rfq.RetailItems 75 | |> List.iter (fun retailItem -> 76 | printfn "OrderProcessor: %s item: %s to: %s" rfq.RfqId retailItem.ItemId quoterId 77 | quoteProcessor 82 | let (SubscribeToPriceQuoteRequests(quoterId, quoteProcessor)) = subscriber 83 | return! loop <| Map.add quoteProcessor.Path.Name subscriber subscribers 84 | | :? PriceQuote as priceQuote -> 85 | priceQuoteAggregator 88 | priceQuoteAggregator printfn "OrderProcessor: received: %A" bestPriceQuotation 91 | | message -> printfn "OrderProcessor: unexpected: %A" message 92 | return! loop subscribers 93 | } 94 | loop Map.empty 95 | 96 | let budgetHikersPriceQuotes priceQuoteRequestPublisher (mailbox: Actor) = 97 | let quoterId = mailbox.Self.Path.Name 98 | priceQuoteRequestPublisher ) = 118 | let quoterId = mailbox.Self.Path.Name 119 | priceQuoteRequestPublisher ) = 141 | let quoterId = mailbox.Self.Path.Name 142 | priceQuoteRequestPublisher ) = 164 | let quoterId = mailbox.Self.Path.Name 165 | priceQuoteRequestPublisher ) = 188 | let quoterId = mailbox.Self.Path.Name 189 | priceQuoteRequestPublisher } 11 | type OrderPlaced = OrderPlaced of Order 12 | type TypeAItemOrdered = TypeAItemOrdered of OrderItem 13 | type TypeBItemOrdered = TypeBItemOrdered of OrderItem 14 | type TypeCItemOrdered = TypeCItemOrdered of OrderItem 15 | 16 | let orderItemTypeAProcessor (mailbox: Actor<_>) = 17 | let rec loop () = actor { 18 | let! TypeAItemOrdered orderItem = mailbox.Receive () 19 | printfn "OrderItemTypeAProcessor: handling %A" orderItem 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let orderItemTypeBProcessor (mailbox: Actor<_>) = 25 | let rec loop () = actor { 26 | let! TypeBItemOrdered orderItem = mailbox.Receive () 27 | printfn "OrderItemTypeBProcessor: handling %A" orderItem 28 | return! loop () 29 | } 30 | loop () 31 | 32 | let orderItemTypeCProcessor (mailbox: Actor<_>) = 33 | let rec loop () = actor { 34 | let! TypeCItemOrdered orderItem = mailbox.Receive () 35 | printfn "OrderItemTypeCProcessor: handling %A" orderItem 36 | return! loop () 37 | } 38 | loop () 39 | 40 | let orderRouter (mailbox: Actor<_>) = 41 | let orderItemTypeAProcessor = spawn mailbox.Context "orderItemTypeAProcessor" orderItemTypeAProcessor 42 | let orderItemTypeBProcessor = spawn mailbox.Context "orderItemTypeBProcessor" orderItemTypeBProcessor 43 | let orderItemTypeCProcessor = spawn mailbox.Context "orderItemTypeCProcessor" orderItemTypeCProcessor 44 | 45 | let rec loop () = actor { 46 | let! OrderPlaced order = mailbox.Receive () 47 | order.OrderItems 48 | |> Map.iter (fun k orderItem -> 49 | match orderItem.ItemType with 50 | | "TypeA" -> 51 | printfn "OrderRouter: routing %A" orderItem 52 | orderItemTypeAProcessor 54 | printfn "OrderRouter: routing %A" orderItem 55 | orderItemTypeBProcessor 57 | printfn "OrderRouter: routing %A" orderItem 58 | orderItemTypeCProcessor printfn "OrderRouter: received unexpected message") 60 | return! loop () 61 | } 62 | loop () 63 | 64 | let splitter (mailbox: Actor<_>) = 65 | let rec loop () = actor { 66 | let! message = mailbox.Receive () 67 | return! loop () 68 | } 69 | loop () 70 | 71 | let orderRouterRef = spawn system "orderRouter" orderRouter 72 | let orderItem1 = { Id = "1"; ItemType = "TypeA"; Description = "An item of type A."; Price = Money 23.95m } 73 | let orderItem2 = { Id = "2"; ItemType = "TypeB"; Description = "An item of type B."; Price = Money 99.95m } 74 | let orderItem3 = { Id = "3"; ItemType = "TypeC"; Description = "An item of type C."; Price = Money 14.95m } 75 | let orderItems = Map.ofList [ (orderItem1.Id, orderItem1); (orderItem2.Id, orderItem2); (orderItem3.Id, orderItem3) ] 76 | 77 | orderRouterRef 13 | type CheckedPart = CheckedPart of claimCheck: ClaimCheck * partName: string * part: obj 14 | type ProcessStep = ProcessStep of id: string * claimCheck: ClaimCheck 15 | type ProcessMessage = 16 | | CompositeMessage of id: string * part1: Part * part2: Part * part3: Part 17 | | StepCompleted of id: string * claimCheck: ClaimCheck * stepName: string 18 | type ItemChecker() = 19 | let mutable checkedItems = Map.empty 20 | member this.CheckedItemFor (businessId, parts) = CheckedItem(ClaimCheck.Create(), businessId, parts) 21 | member this.CheckItem (CheckedItem(claimCheck, businessId, parts) as item) = checkedItems <- checkedItems |> Map.add claimCheck item 22 | member this.ClaimItem claimCheck = checkedItems |> Map.find claimCheck 23 | member this.ClaimPart (claimCheck, partName) = 24 | let (CheckedItem(_, _, parts)) = checkedItems |> Map.find claimCheck 25 | CheckedPart(claimCheck, partName, parts |> Map.find partName) 26 | member this.RemoveItem claimCheck = checkedItems <- checkedItems |> Map.remove claimCheck 27 | 28 | let ``process`` steps (itemChecker: ItemChecker) (mailbox: Actor<_>) = 29 | let rec loop stepIndex = actor { 30 | let! message = mailbox.Receive () 31 | match message with 32 | | CompositeMessage(id, (Part(part1Name) as part1), (Part(part2Name) as part2), (Part(part3Name) as part3)) -> 33 | let parts = [ (part1Name, part1); (part2Name, part2); (part3Name, part3) ] |> Map.ofList 34 | let (CheckedItem(claimCheck, _, _) as checkedItem) = itemChecker.CheckedItemFor (id, parts) 35 | itemChecker.CheckItem checkedItem 36 | steps |> List.item stepIndex 39 | if stepIndex < steps.Length then steps |> List.item stepIndex ) = 46 | let rec loop () = actor { 47 | let! (ProcessStep(id, claimCheck) as processStep) = mailbox.Receive () 48 | let claimedPart = itemChecker.ClaimPart (claimCheck, "partA1") 49 | printfn "Step1: processing %A with %A" processStep claimedPart 50 | mailbox.Sender () ) = 56 | let rec loop () = actor { 57 | let! (ProcessStep(id, claimCheck) as processStep) = mailbox.Receive () 58 | let claimedPart = itemChecker.ClaimPart (claimCheck, "partB2") 59 | printfn "Step2: processing %A with %A" processStep claimedPart 60 | mailbox.Sender () ) = 66 | let rec loop () = actor { 67 | let! (ProcessStep(id, claimCheck) as processStep) = mailbox.Receive () 68 | let claimedPart = itemChecker.ClaimPart (claimCheck, "partC3") 69 | printfn "Step3: processing %A with %A" processStep claimedPart 70 | mailbox.Sender () ) = 18 | let rec loop () = actor { 19 | let! (DoctorVisitCompleted(patientId, firstName, date, _, _, _)) = mailbox.Receive () 20 | printfn "AccountingEnricherDispatcher: querying and forwarding." 21 | let lastName = "Doe" 22 | let carrier = "Kaiser" 23 | let socialSecurityNumber = "111-22-3333" 24 | let patientDetails = { LastName = lastName; SocialSecurityNumber = socialSecurityNumber; Carrier = carrier } 25 | let enrichedDoctorVisitCompleted = DoctorVisitCompleted.Create (patientId, firstName, date, patientDetails) 26 | accountingSystemDispatcher.Forward enrichedDoctorVisitCompleted 27 | return! loop () 28 | } 29 | loop () 30 | 31 | let accountingSystemDispatcher (mailbox: Actor<_>) = 32 | let rec loop () = actor { 33 | let! doctorVisitCompleted = mailbox.Receive () 34 | printfn "AccountingSystemDispatcher: sending to Accounting System..." 35 | return! loop () 36 | } 37 | loop () 38 | 39 | let scheduledDoctorVisit patientId firstName (mailbox: Actor<_>) = 40 | let rec loop () = actor { 41 | let! (VisitCompleted dispatcher) = mailbox.Receive () 42 | printfn "ScheduledDoctorVisit: completing visit." 43 | let completedOn = DateTimeOffset.UtcNow 44 | dispatcher ) = 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | match message with 16 | | UnfilteredPayload payload -> 17 | printfn "MessageContentFilter: received unfiltered message: %s" payload 18 | mailbox.Sender () printfn "MessageContentFilter: unexpected" 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let messageExchangeDispatcher (mailbox: Actor<_>) = 25 | let messageContentFilter = spawn mailbox.Context "messageContentFilter" messageContentFilter 26 | let rec loop () = actor { 27 | let! message = mailbox.Receive () 28 | match message with 29 | | UnfilteredPayload payload -> 30 | printfn "MessageExchangeDispatcher: received unfiltered message: %s" payload 31 | messageContentFilter printfn "MessageExchangeDispatcher: dispatching: %A" message 33 | return! loop () 34 | } 35 | loop () 36 | 37 | let messageExchangeDispatcherRef = spawn system "messageExchangeDispatcher" messageExchangeDispatcher 38 | 39 | messageExchangeDispatcherRef unit 11 | abstract member SetUpReplyToSupport: string -> unit 12 | type IRegisterCustomer = 13 | inherit IReplyToSupport 14 | abstract member Message: string with get 15 | type RabbitMQReplyToSupport() = 16 | let mutable returnAddress = String.Empty 17 | interface IReplyToSupport with 18 | member this.Reply message = printfn "RabbitMQReplyToSupport: Replying %A to \"%s\"" message returnAddress 19 | member this.SetUpReplyToSupport replyReturnAddress = returnAddress <- replyReturnAddress 20 | type RegisterCustomerRabbitMQReplyToMapEnvelope(mapMessage: Map) as this = 21 | inherit RabbitMQReplyToSupport() 22 | let this = this :> IReplyToSupport 23 | do this.SetUpReplyToSupport(mapMessage |> Map.find "returnAddress") 24 | let message = mapMessage |> Map.find "message" 25 | interface IRegisterCustomer with 26 | member this.Message with get () = message 27 | 28 | let customerRegistrar (mailbox: Actor) = 29 | let rec loop () = actor { 30 | let! registerCustomer = mailbox.Receive () 31 | printfn "CustomerRegistrar: Received \"%s\"" registerCustomer.Message 32 | registerCustomer.Reply "hi" 33 | return! loop () 34 | } 35 | loop () 36 | 37 | let receivedMessageAsMap _ = [ ("returnAddress", "http://caller/"); ("message", "hello") ] |> Map.ofList 38 | let wireMessage = () 39 | let mapMessage = receivedMessageAsMap wireMessage 40 | 41 | let customerRegistrarRef = spawn system "customerRegistrar" customerRegistrar 42 | 43 | let registerCustomer = RegisterCustomerRabbitMQReplyToMapEnvelope(mapMessage) 44 | customerRegistrarRef ) = 30 | let applicationId = mailbox.Self.Path.Name 31 | tradingBus 38 | let result = buyerService.PlaceBuyOrder (i, s, q, p) 39 | tradingBus 41 | let result = buyerService.PlaceBuyOrder (i, s, q, p) 42 | tradingBus ) = 48 | let rec loop () = actor { 49 | let! message = mailbox.Receive () 50 | printfn "TradingBus: received %A" message 51 | return! loop () 52 | } 53 | loop () 54 | 55 | let tradingBusRef = spawn system "tradingBus" tradingBus 56 | let stockTraderRef = spawn system "stockTrader" (stockTrader <| tradingBusRef <| new BuyerService() <| new SellerService ()) 57 | 58 | stockTraderRef ) = 11 | let translateToProductQuery message = message |> Encoding.UTF8.GetString |> ProductQuery 12 | 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | let (ProductQuery value) = message |> translateToProductQuery 16 | printfn "ProductQueriesChannel: ProductQuery received, value: %s" <| value 17 | return! loop () 18 | } 19 | loop () 20 | 21 | let productQueriesChannelRef = spawn system "productQueriesChannel" productQueriesChannel 22 | 23 | productQueriesChannelRef ) = 9 | let rec loop () = actor { 10 | let! deadLetter = mailbox.Receive () 11 | printfn "SysListner, DeadLetter received: %A" deadLetter.Message 12 | return! loop () 13 | } 14 | loop () 15 | 16 | let sysListenerRef = spawn system "sysListener" sysListener 17 | subscribe typeof sysListenerRef system.EventStream 18 | 19 | let deadActorRef = select "akka://system/user/deadActor" system 20 | deadActorRef = { Sender: IActorRef; Receiver: IActorRef; Message: 'a } 11 | type ProcessIncomingOrder = ProcessIncomingOrder of byte array 12 | 13 | let invalidMessageChannel (mailbox: Actor<_>) = 14 | let rec loop () = actor { 15 | let! { Sender = s; Receiver = r; Message = m } = mailbox.Receive () 16 | printfn "InvalidMessageChannel: InvalidMessage received, message: %A" m 17 | return! loop () 18 | } 19 | loop () 20 | 21 | let authenticator (nextFilter: IActorRef) (invalidMessageChannel: IActorRef) (mailbox: Actor<_>) = 22 | let rec loop () = actor { 23 | let! message = mailbox.Receive () 24 | match box message with 25 | | :? ProcessIncomingOrder as message -> 26 | let (ProcessIncomingOrder(bytes)) = message 27 | let text = Encoding.Default.GetString bytes 28 | printfn "Decrypter: processing %s" text 29 | let orderText = text.Replace ("(encryption)", String.Empty) 30 | nextFilter invalidMessageChannel ) = 37 | let rec loop () = actor { 38 | let! message = mailbox.Receive () 39 | return! loop () 40 | } 41 | loop () 42 | 43 | let invalidMessageChannelRef = spawn system "invalidMessageChannel" invalidMessageChannel 44 | let nextFilterRef = spawn system "nextFilter" nextFilter 45 | let authenticatorRef = spawn system "authenticator" <| authenticator nextFilterRef invalidMessageChannelRef 46 | 47 | authenticatorRef ) = 10 | let translatedToInventoryProductAlloction = sprintf "Inventory product alloction for %s" 11 | let acknowledgeDelivery (RabbitMQTextMessage textMessage) = printfn "InventoryProductAllocationBridge: acknowledged '%s'" textMessage 12 | 13 | let rec loop () = actor { 14 | let! message = mailbox.Receive () 15 | let (RabbitMQTextMessage textMessage) = message 16 | printfn "InventoryProductAllocationBridge: received '%s'" textMessage 17 | let inventoryProductAllocation = translatedToInventoryProductAlloction textMessage 18 | printfn "InventoryProductAllocationBridge: translated '%s'" inventoryProductAllocation 19 | acknowledgeDelivery message 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let inventoryProductAllocationBridgeRef = spawn system "inventoryProductAllocationBridge" inventoryProductAllocationBridge 25 | 26 | inventoryProductAllocationBridgeRef ) = 25 | let rec loop commandHandlers notificationInterests = actor { 26 | let dispatchCommand commandId command = 27 | commandHandlers 28 | |> Map.tryFind commandId 29 | |> Option.map (fun hs -> hs |> List.iter (fun (CommandHandler(_, h)) -> h ignore 31 | 32 | let dispatchNotification notificationId notification = 33 | notificationInterests 34 | |> Map.tryFind notificationId 35 | |> Option.map (fun hs -> hs |> List.iter (fun (NotificationInterest(_, i)) -> i ignore 37 | 38 | let registerCommandHandler commandId applicationId handler = 39 | let commandHandler = CommandHandler(applicationId, handler) 40 | commandHandlers 41 | |> Map.tryFind commandId 42 | |> Option.fold (fun _ hs -> commandHandler :: hs) [commandHandler] 43 | |> fun hs -> Map.add commandId hs commandHandlers 44 | 45 | let registerNotificationInterest notificationId applicationId interested = 46 | let notificationInterest = NotificationInterest(applicationId, interested) 47 | notificationInterests 48 | |> Map.tryFind notificationId 49 | |> Option.fold (fun _ is -> notificationInterest :: is) [notificationInterest] 50 | |> fun is -> Map.add notificationId is notificationInterests 51 | 52 | let! message = mailbox.Receive () 53 | match message with 54 | | RegisterCommandHandler(applicationId, commandId, handler) -> 55 | return! loop (registerCommandHandler commandId applicationId handler) notificationInterests 56 | | RegisterNotificationInterest(applicationId, notificationId, interested) -> 57 | return! loop commandHandlers (registerNotificationInterest notificationId applicationId interested) 58 | | TradingCommand(commandId, command) -> dispatchCommand commandId command 59 | | TradingNotification(notificationId, notification) -> dispatchNotification notificationId notification 60 | | Status -> 61 | printfn "TradingBus: STATUS: %A" commandHandlers 62 | printfn "TradingBus: STATUS: %A" notificationInterests 63 | return! loop commandHandlers notificationInterests 64 | } 65 | loop Map.empty Map.empty 66 | 67 | let marketAnalysisTools tradingBus (mailbox: Actor<_>) = 68 | let applicationId = mailbox.Self.Path.Name 69 | tradingBus printfn "MarketAnalysisTools: adding holding: %A" executed 76 | | SellOrderExecuted _ as executed -> printfn "MarketAnalysisTools: adjusting holding: %A" executed 77 | return! loop () 78 | } 79 | loop () 80 | 81 | let portfolioManager tradingBus (mailbox: Actor<_>) = 82 | let applicationId = mailbox.Self.Path.Name 83 | tradingBus printfn "PortfolioManager: adding holding: %A" executed 90 | | SellOrderExecuted _ as executed -> printfn "PortfolioManager: adjusting holding: %A" executed 91 | return! loop () 92 | } 93 | loop () 94 | 95 | let stockTrader tradingBus (mailbox: Actor<_>) = 96 | let applicationId = mailbox.Self.Path.Name 97 | tradingBus 104 | printfn "StockTrader: buying for: %A" buy 105 | tradingBus 107 | printfn "StockTrader: selling for: %A" sell 108 | tradingBus ) = 10 | let rec loop () = actor { 11 | let! message = mailbox.Receive () 12 | return! loop () 13 | } 14 | actorB ) = 19 | let rec loop hello helloAgain goodbye goodbyeAgain = actor { 20 | let! message = mailbox.Receive () 21 | let hello = hello + (if message.Contains "Hello" then 1 else 0) 22 | let helloAgain = helloAgain + (if message.Contains "Hello again" then 1 else 0) 23 | assertion (hello = 0 || hello > helloAgain) 24 | let goodbye = goodbye + (if message.Contains "Goodbye" then 1 else 0) 25 | let goodbyeAgain = goodbyeAgain + (if message.Contains "Goodbye again" then 1 else 0) 26 | assertion (goodbye = 0 || goodbye > goodbyeAgain) 27 | printfn "ActorB: received %s" message 28 | return! loop hello helloAgain goodbye goodbyeAgain 29 | } 30 | loop 0 0 0 0 31 | 32 | let actorC actorB (mailbox: Actor<_>) = 33 | let rec loop () = actor { 34 | let! message = mailbox.Receive () 35 | return! loop () 36 | } 37 | actorB ) = 13 | let rec loop () = actor { 14 | let! { Market = Market m; Ticker = Symbol t; Price = Money p } = mailbox.Receive () 15 | printfn "QuoteListener: PricedQuoted received, market: %s, ticker: %s, price: %M" m t p 16 | return! loop () 17 | } 18 | loop () 19 | 20 | let quoteListenerRef = spawn system "quoteListenerRef" quoteListener 21 | subscribe typeof quoteListenerRef system.EventStream 22 | publish { Market = Market("quotes/NASDAQ"); Ticker = Symbol "MSFT"; Price = Money(37.16m) } system.EventStream -------------------------------------------------------------------------------- /MessagingWithActors/Message.fsx: -------------------------------------------------------------------------------- 1 | #load "../References.fsx" 2 | 3 | open Akka.FSharp 4 | 5 | let system = System.create "system" <| Configuration.load () 6 | 7 | 8 | // Scalar Messsages 9 | 10 | let scalarValuePrinter (mailbox: Actor<_>) = 11 | let rec loop () = actor { 12 | let! message = mailbox.Receive () 13 | match box message with 14 | | :? string as msg -> printfn "ScalarValuePrinter: received String %s" msg 15 | | :? int as msg -> printfn "ScalarValuePrinter: received Int %i" msg 16 | | _ -> () 17 | return! loop () 18 | } 19 | loop () 20 | 21 | let scalarValuePrinterRef = spawn system "scalarValuePrinter" scalarValuePrinter 22 | 23 | scalarValuePrinterRef ) = 39 | let rec loop () = actor { 40 | let! message = mailbox.Receive () 41 | match message with 42 | | ExecuteBuyOrder(i, s, q, p) -> mailbox.Sender () mailbox.Sender () ) = 49 | let rec loop () = actor { 50 | let! message = mailbox.Receive () 51 | match message with 52 | | BuyOrderExecuted(i, Symbol s, q, Money p) -> printfn "Caller: received BuyOrderExecuted %s %s %i %M" i s q p 53 | | SellOrderExecuted(i, Symbol s, q, Money p) -> printfn "Caller: received SellOrderExecuted %s %s %i %M" i s q p 54 | return! loop () 55 | } 56 | orderProcessor ) = 10 | let rec loop () = actor { 11 | let! ProcessJob(x,y,z) = mailbox.Receive () 12 | printfn "Processor: received ProcessJob %i %i %i" x y z 13 | return! loop () 14 | } 15 | loop () 16 | 17 | let processorRef = spawn system "processor" processor 18 | 19 | processorRef ) = 15 | let quoterId = mailbox.Self.Path.Name 16 | let rec loop () = actor { 17 | let! message = mailbox.Receive () 18 | match message with 19 | | RequestPriceQuote(retailerId, rfqId, itemId) -> 20 | printfn "HighSierraPriceQuotes: RequestPriceQuote received" 21 | discounter 23 | printfn "HighSierraPriceQuotes: DiscountPriceCalculated received" 24 | requestedBy ) = 30 | let rec loop () = actor { 31 | let! CalculatedDiscountPriceFor(requester, retailerId, rfqId, itemId) = mailbox.Receive () 32 | printfn "Discounter: CalculatedDiscountPriceFor received" 33 | mailbox.Sender () ) = 39 | let rec loop () = actor { 40 | let! PriceQuote(_, _, _, _,retailPrice, discountPrice) = mailbox.Receive () 41 | printfn "Requester: PriceQuote received, retailPrice: %M, discountPrice %M" retailPrice discountPrice 42 | return! loop () 43 | } 44 | quotes ) = 9 | let rec loop alternate = actor { 10 | let alternateProcessor () = if alternate = 1 then processor1, 2 else processor2, 1 11 | let! message = mailbox.Receive () 12 | let processor, nextAlternate = alternateProcessor () 13 | printfn "AlternatingRouter: routing %O to %s" message processor.Path.Name 14 | processor ) = 20 | let rec loop () = actor { 21 | let! message = mailbox.Receive () 22 | printfn "Processor: %s received %O" message mailbox.Self.Path.Name 23 | return! loop () 24 | } 25 | loop () 26 | 27 | let processor1Ref = spawn system "processor1" processor 28 | let processor2Ref = spawn system "processor2" processor 29 | let alternatingRouterRef = spawn system "alternatingRouter" <| alternatingRouter processor1Ref processor2Ref 30 | 31 | [1..10] |> List.iter (fun i -> alternatingRouterRef ) = 12 | let rec loop () = actor { 13 | let! message = mailbox.Receive () 14 | let text = Encoding.Default.GetString message 15 | printfn "OrderAcceptanceEndpoint: processing %s" text 16 | nextFilter ) = 22 | let rec loop () = actor { 23 | let! ProcessIncomingOrder(bytes) = mailbox.Receive () 24 | let text = Encoding.Default.GetString bytes 25 | printfn "Decrypter: processing %s" text 26 | let orderText = text.Replace ("(encryption)", String.Empty) 27 | nextFilter ) = 33 | let rec loop () = actor { 34 | let! ProcessIncomingOrder(bytes) = mailbox.Receive () 35 | let text = Encoding.Default.GetString bytes 36 | printfn "Authenticator: processing %s" text 37 | let orderText = text.Replace ("(certificate)", String.Empty) 38 | nextFilter ) = 44 | let orderIdFrom (orderText: string) = 45 | let orderIdIndex = orderText.IndexOf ("id='") + 4 46 | let orderIdLastIndex = orderText.IndexOf ("'", orderIdIndex) 47 | orderText.Substring (orderIdIndex, orderIdLastIndex) 48 | 49 | let rec loop (processedOrderIds: string Set) = actor { 50 | let! ProcessIncomingOrder(bytes) = mailbox.Receive () 51 | let text = Encoding.Default.GetString bytes 52 | printfn "Deduplicator: processing %s" text 53 | let orderId = orderIdFrom text 54 | if (not <| Set.contains orderId processedOrderIds) then 55 | nextFilter ) = 64 | let rec loop () = actor { 65 | let! ProcessIncomingOrder(bytes) = mailbox.Receive () 66 | let text = Encoding.Default.GetString bytes 67 | printfn "OrderManagementSystem: processing unique order: %s" text 68 | return! loop () 69 | } 70 | loop () 71 | 72 | let orderText = "(encryption)(certificate)..." 73 | let rawOrderBytes = Encoding.Default.GetBytes orderText 74 | 75 | let filter5 = spawn system "orderManagementSystem" orderManagerSystem 76 | let filter4 = spawn system "deduplicator" <| deduplicator filter5 77 | let filter3 = spawn system "authenticator" <| authenticator filter4 78 | let filter2 = spawn system "decrypter" <| decrypter filter3 79 | let filter1 = spawn system "orderAcceptanceEndpoint" <| orderAcceptanceEndpoint filter2 80 | 81 | filter1 ] 2 | let main argv = 3 | 0 4 | -------------------------------------------------------------------------------- /References.fsx: -------------------------------------------------------------------------------- 1 | #I __SOURCE_DIRECTORY__ 2 | #r "packages/Akka/lib/net45/Akka.dll" 3 | #r "packages/Akka.FSharp/lib/net45/Akka.FSharp.dll" 4 | #r "packages/FsPickler/lib/net45/FsPickler.dll" 5 | #r "packages/Newtonsoft.Json/lib/net45/Newtonsoft.Json.dll" 6 | #r "packages/Akka.Persistence/lib/net45/Akka.Persistence.dll" 7 | #r "packages/Akka.Persistence.FSharp/lib/net45/Akka.Persistence.FSharp.dll" 8 | #r "packages/Google.ProtocolBuffers/lib/net40/Google.ProtocolBuffers.dll" 9 | #r "packages/Google.ProtocolBuffers/lib/net40/Google.ProtocolBuffers.Serialization.dll" -------------------------------------------------------------------------------- /SystemManagementInfrastructure/ChannelPurger.fsx: -------------------------------------------------------------------------------- 1 | #load "../References.fsx" 2 | 3 | open System 4 | open Akka.FSharp 5 | 6 | let system = System.create "system" <| Configuration.load () 7 | 8 | type Message = 9 | | ProcessOrder 10 | | PurgeNow 11 | | StopPurge 12 | 13 | let orderProcessor (mailbox: Actor<_>) = 14 | let rec normal () = actor { 15 | let! message = mailbox.Receive () 16 | match message with 17 | | ProcessOrder -> 18 | printfn "Normal: %A" message 19 | return! normal () 20 | | PurgeNow -> 21 | printfn "Normal: %A" message 22 | return! purger () 23 | | _ -> return! normal () } 24 | and purger () = actor { 25 | let! message = mailbox.Receive () 26 | match message with 27 | | StopPurge -> 28 | printfn "Purger: %A" message 29 | return! normal () 30 | | _ -> return! purger () 31 | } 32 | normal () 33 | 34 | let orderProcessorRef = spawn system "orderProcessor" orderProcessor 35 | 36 | orderProcessorRef ) = 11 | let rec loop () = actor { 12 | let! message = mailbox.Receive () 13 | printfn "OrderProcessor: %A" message 14 | return! loop () 15 | } 16 | loop () 17 | 18 | let messageDebugger next (mailbox: Actor<_>) = 19 | let rec loop () = actor { 20 | let! message = mailbox.Receive () 21 | printfn "MessageDebugger: %A" message 22 | next ) = 28 | let rec loop () = actor { 29 | let! message = mailbox.Receive () 30 | printfn "MessageTester: %A" message 31 | next ) = 37 | let rec loop () = actor { 38 | let! message = mailbox.Receive () 39 | printfn "MessageValidator: %A" message 40 | next ) = 46 | let rec loop () = actor { 47 | let! message = mailbox.Receive () 48 | printfn "MessageLogger: %A" message 49 | next ) = 27 | let random = Random() 28 | let user = sprintf "user%i" (random.Next 100) 29 | let wasProcessed = sprintf "Processed: %i" (random.Next 5) 30 | let because = sprintf "Because: %i" (random.Next 10) 31 | let entry = Entry.Create (Who user, What wasProcessed, Where("processor", mailbox.Self.Path.Name), DateTimeOffset.UtcNow, Why because) 32 | let report message heading = printfn "%s %s: %A" mailbox.Self.Path.Name (defaultArg heading "received") message 33 | 34 | let rec loop () = actor { 35 | let! message = mailbox.Receive () 36 | report message None 37 | let nextMessage = message.Including entry 38 | match next with 39 | | Some next -> next report nextMessage <| Some "complete" 41 | return! loop () 42 | } 43 | loop () 44 | 45 | let processor3Ref = spawn system "processor3" <| processor None 46 | let processor2Ref = spawn system "processor2" <| processor (Some processor3Ref) 47 | let processor1Ref = spawn system "processor1" <| processor (Some processor2Ref) 48 | 49 | let entry = Entry.Create (Who "driver", What "Started", Where("processor", "driver"), DateTimeOffset.UtcNow, Why "Running processors") 50 | processor1Ref requestId 13 | type ServiceReply = 14 | | ServiceReplyOne of replyId : string 15 | | ServiceReplyTwo of replyId : string 16 | | ServiceReplyThree of replyId : string with 17 | member this.ReplyId with get () = match this with | ServiceReplyOne replyId | ServiceReplyTwo replyId | ServiceReplyThree replyId -> replyId 18 | type RequestService = RequestService of service: ServiceRequest 19 | 20 | let serviceProvider (mailbox: Actor<_>) = 21 | let rec loop () = actor { 22 | let! message = mailbox.Receive () 23 | match message with 24 | | ServiceRequestOne requestId -> mailbox.Sender () mailbox.Sender () mailbox.Sender () ) = 32 | let rec loop () = actor { 33 | let! message = mailbox.Receive () 34 | match box message with 35 | | :? RequestService as request -> 36 | printfn "ServiceRequester: %s: %A" mailbox.Self.Path.Name request 37 | let (RequestService service) = request 38 | serviceProvider printfn "ServiceRequester: %s: %A" mailbox.Self.Path.Name reply 40 | return! loop () 41 | } 42 | loop () 43 | 44 | let serviceProviderProxy serviceProvider (mailbox: Actor<_>) = 45 | let analyzeReply reply = printfn "Reply analyzed: %A" reply 46 | let analyzeRequest request = printfn "Request analyzed: %A" request 47 | 48 | let rec loop requesters = actor { 49 | let! message = mailbox.Receive () 50 | match box message with 51 | | :? ServiceRequest as request -> 52 | let requesters = requesters |> Map.add request.RequestId (mailbox.Sender ()) 53 | serviceProvider 57 | let requester = requesters |> Map.tryFind reply.ReplyId 58 | match requester with 59 | | Some sender -> 60 | analyzeReply reply 61 | sender Map.remove reply.ReplyId 63 | return! loop requesters 64 | | None -> return! loop requesters 65 | | _ -> return! loop requesters 66 | } 67 | loop Map.empty 68 | 69 | let serviceProviderRef = spawn system "serviceProvider" serviceProvider 70 | let proxyRef = spawn system "proxy" <| serviceProviderProxy serviceProviderRef 71 | let requester1Ref = spawn system "requester1" <| serviceRequester proxyRef 72 | let requester2Ref = spawn system "requester2" <| serviceRequester proxyRef 73 | let requester3Ref = spawn system "requester3" <| serviceRequester proxyRef 74 | 75 | requester1Ref bool) (message)) 12 | if (isTest message) then Some message else None 13 | 14 | let processor (mailbox: Actor) = 15 | let rec loop () = actor { 16 | let! message = mailbox.Receive () 17 | match message with 18 | | TestMessage message -> printfn "Test message: %A" message 19 | | message -> printfn "Production message: %A" message 20 | return! loop () 21 | } 22 | loop () 23 | 24 | let processorRef = spawn system "processor" processor 25 | 26 | processorRef ) = 11 | let rec loop () = actor { 12 | let! message = mailbox.Receive () 13 | printfn "OrderProcessor: %A" message 14 | return! loop () 15 | } 16 | loop () 17 | 18 | let messageLogger next (mailbox: Actor<_>) = 19 | let rec loop () = actor { 20 | let! message = mailbox.Receive () 21 | printfn "MessageLogger: %A" message 22 | next 2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /paket.dependencies: -------------------------------------------------------------------------------- 1 | source https://nuget.org/api/v2 2 | framework >= net452 3 | 4 | nuget FSharp.Core 5 | nuget Akka.FSharp 6 | nuget Akka.Persistence.FSharp -------------------------------------------------------------------------------- /paket.lock: -------------------------------------------------------------------------------- 1 | FRAMEWORK: >= NET452 2 | NUGET 3 | remote: https://nuget.org/api/v2 4 | specs: 5 | Akka (1.0.5) 6 | Newtonsoft.Json (>= 7.0.1) 7 | Akka.FSharp (1.0.5) 8 | Akka (>= 1.0.5) 9 | FsPickler (>= 1.2.21) 10 | FSPowerPack.Core.Community (>= 3.0.0.0) 11 | FSPowerPack.Linq.Community (>= 3.0.0.0) 12 | Akka.Persistence (1.0.5.15-beta) 13 | Akka (>= 1.0.5) 14 | Google.ProtocolBuffers (>= 2.4.1.521) 15 | Newtonsoft.Json (>= 7.0.1) 16 | Akka.Persistence.FSharp (1.0.5.15-beta) 17 | Akka.Persistence (>= 1.0.5.15-beta) 18 | FSharp.Core (4.0.0.1) 19 | FsPickler (1.7.0) 20 | FSPowerPack.Core.Community (3.0.0) 21 | FSPowerPack.Linq.Community (3.0.0) 22 | FSPowerPack.Core.Community 23 | Google.ProtocolBuffers (2.4.1.555) 24 | Newtonsoft.Json (7.0.1) 25 | -------------------------------------------------------------------------------- /paket.references: -------------------------------------------------------------------------------- 1 | Akka.FSharp 2 | Akka.Persistence.FSharp 3 | FSharp.Core --------------------------------------------------------------------------------