├── .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
--------------------------------------------------------------------------------