6 people like it.

Event Sourcing

Playing with simplified domain modules and event sourcing in F#

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 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: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
157: 
158: 
159: 
160: 
161: 
162: 
163: 
164: 
165: 
166: 
167: 
168: 
169: 
170: 
171: 
172: 
173: 
174: 
175: 
176: 
177: 
178: 
179: 
180: 
181: 
182: 
183: 
184: 
185: 
186: 
187: 
188: 
189: 
190: 
191: 
192: 
193: 
194: 
195: 
196: 
197: 
198: 
199: 

module State.EventSource.DomainTypes

module Data =
    type User =
        | User of string

module Command =
    open Data

    type Command =
        | CreateNotification of User
        | ApproveRetrieve of User
        | ApproveSend of User

module Events =
    open Data
    open Fleece
    open Fleece.Operators
    open FSharpPlus

    type NotificationEvent =
        | NotificationCreated of User
        | RetrieveApproved of User
        | SendApproved of User
        | RetrieveStarted
        | RetrieveCompleted
        | SendStarted
        | SendCompleted
        static member ToJSON (x : NotificationEvent) =
            match x with
            | NotificationCreated (User u) ->
                jobj [
                    "eventType" .= "notificationCreated"
                    "value" .= u
                ]
            | RetrieveApproved (User u) ->
                jobj [
                    "eventType" .= "retrieveApproved"
                    "value" .= u
                ]
            | SendApproved (User u) ->
                jobj [
                    "eventType" .= "sendApproved"
                    "value" .= u
                ]
            | RetrieveStarted ->
                jobj [ "eventType" .= "retrieveStarted" ]
            | RetrieveCompleted ->
                jobj [ "eventType" .= "retrieveCompleted" ]
            | SendStarted ->
                jobj [ "eventType" .= "sendStarted" ]
            | SendCompleted ->
                jobj [ "eventType" .= "sendCompleted" ]
        static member FromJSON (_ : NotificationEvent) =
            function
            | JObject o ->
                monad {
                    let! eventType = o .@ "eventType"
                    match eventType with
                    | "notificationCreated" ->
                        let! value = o .@ "value"
                        return NotificationCreated (User value)
                    | "retrieveApproved" ->
                        let! value = o .@ "value"
                        return RetrieveApproved (User value)
                    | "sendApproved" ->
                        let! value = o .@ "value"
                        return SendApproved (User value)
                    | "retrieveStarted" ->
                        return RetrieveStarted
                    | "retrieveCompleted" ->
                        return RetrieveCompleted
                    | "sendStarted" ->
                        return SendStarted
                    | "sendCompleted" ->
                        return SendCompleted
                    | x ->
                        return! Failure (sprintf "Unknown notification event type: %s." x)
                }
            | x -> Failure (sprintf "Expected notification event, found %A." x)
            

module Notification =
    open Events
    type RetrieveState =
        | InProgress
        | Error

    type SendApprovalState =
        | WaitingApproval
        | Approved

    type SendState =
        | InProgress
        | Error

    type NotificationState =
        | Nothing
        | Held of SendApprovalState
        | ReadyForRetrieve of SendApprovalState
        | Retrieving of RetrieveState * SendApprovalState
        | ReadyForSend of SendApprovalState
        | Sending
        | Complete
        | Error of string
        static member fold state event =
            match event with
            | NotificationCreated _ ->
                match state with
                | Nothing ->
                    Held WaitingApproval
                | _ ->
                    Error "A notification with this ID already exists"
            | RetrieveApproved _ ->
                match state with
                | Held sendApproval ->
                    ReadyForRetrieve sendApproval
                | Nothing ->
                    Error "No notification with this ID has been created?"
                | _ ->
                    state
            | RetrieveStarted ->
                match state with
                | ReadyForRetrieve sendApproval ->
                    Retrieving (RetrieveState.InProgress, sendApproval)
                | _ ->
                    Error "A notification should not start retrieving until it's ready to retrieve."
            | RetrieveCompleted ->
                match state with
                | Retrieving (RetrieveState.InProgress, sendApproval) ->
                    ReadyForSend sendApproval
                | _ ->
                    Error "Can't complete retrieve if it hasn't started."
            | SendApproved _ ->
                match state with
                | Held _ -> Held Approved
                | ReadyForRetrieve _ -> ReadyForRetrieve Approved
                | Retrieving (retrieveState, _) -> Retrieving (retrieveState, Approved)
                | ReadyForSend _ -> ReadyForSend Approved
                | Nothing -> Error "Notification doesn't exist."
                | _ -> Error "Send already started!"
            | SendStarted ->
                match state with
                | ReadyForSend Approved ->
                    Sending
                | _ ->
                    Error "Can't start sending unless it was waiting to send."
            | SendCompleted ->
                match state with
                | Sending ->
                    Complete
                | _ ->
                    Error "Can't complete if it hasn't started sending."
            
module Audit =
    open Data
    open Events
    type Auditors =
        {
            Creator : User
            RetrieveAuthorisor : User option
            SendAuthorisor : User option
        }

    type AuditState =
        | Nothing
        | Error of string
        | Auditors of Auditors
        static member fold state event =
            match event with
            | NotificationCreated user ->
                match state with
                | Nothing ->
                    Auditors { Creator = user; RetrieveAuthorisor = None; SendAuthorisor = None }
                | _ ->
                    Error "A audit trail with this ID already exists"
            | RetrieveApproved user ->
                match state with
                | Nothing ->
                    Error "No notification with this ID has been created?"
                | Auditors { Creator = c; RetrieveAuthorisor = None; SendAuthorisor = s } ->
                    Auditors { Creator = c; RetrieveAuthorisor = Some user; SendAuthorisor = s }
                | Auditors _
                | Error _ ->
                    Error "Retrieve cannot be authorised twice."
            | SendApproved user ->
                match state with
                | Nothing ->
                    Error "No notification with this ID has been created?"
                | Auditors { Creator = c; RetrieveAuthorisor = r; SendAuthorisor = None } ->
                    Auditors { Creator = c; RetrieveAuthorisor = r; SendAuthorisor = Some user }
                | Auditors _
                | Error _ ->
                    Error "Retrieve cannot be authorised twice."
            | RetrieveStarted
            | RetrieveCompleted
            | SendStarted
            | SendCompleted ->
                state
namespace State
namespace State.EventSource
module DomainTypes

from State.EventSource
namespace Microsoft.FSharp.Data
Multiple items
union case User.User: string -> User

--------------------
type User = | User of string

Full name: State.EventSource.DomainTypes.Data.User
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
Multiple items
module Data

from State.EventSource.DomainTypes

--------------------
namespace Microsoft.FSharp.Data
type Command =
  | CreateNotification of User
  | ApproveRetrieve of User
  | ApproveSend of User

Full name: State.EventSource.DomainTypes.Command.Command
union case Command.CreateNotification: User -> Command
union case Command.ApproveRetrieve: User -> Command
union case Command.ApproveSend: User -> Command
namespace Fleece
Multiple items
module Fleece

from Fleece

--------------------
namespace Fleece
module Operators

from Fleece.Fleece
namespace FSharpPlus
type NotificationEvent =
  | NotificationCreated of User
  | RetrieveApproved of User
  | SendApproved of User
  | RetrieveStarted
  | RetrieveCompleted
  | SendStarted
  | SendCompleted
  static member FromJSON : NotificationEvent -> (JsonValue -> 'a)
  static member ToJSON : x:NotificationEvent -> JsonValue

Full name: State.EventSource.DomainTypes.Events.NotificationEvent
union case NotificationEvent.NotificationCreated: User -> NotificationEvent
union case NotificationEvent.RetrieveApproved: User -> NotificationEvent
union case NotificationEvent.SendApproved: User -> NotificationEvent
union case NotificationEvent.RetrieveStarted: NotificationEvent
union case NotificationEvent.RetrieveCompleted: NotificationEvent
union case NotificationEvent.SendStarted: NotificationEvent
union case NotificationEvent.SendCompleted: NotificationEvent
static member NotificationEvent.ToJSON : x:NotificationEvent -> System.Json.JsonValue

Full name: State.EventSource.DomainTypes.Events.NotificationEvent.ToJSON
val x : NotificationEvent
val u : string
val jobj : x:seq<string * System.Json.JsonValue> -> System.Json.JsonValue

Full name: Fleece.Fleece.jobj
static member NotificationEvent.FromJSON : NotificationEvent -> (System.Json.JsonValue -> 'a)

Full name: State.EventSource.DomainTypes.Events.NotificationEvent.FromJSON
Multiple items

--------------------
val monad : MonadBuilder

Full name: FSharpPlus.Builders.monad
Multiple items
val Failure : x:'a -> Choice<'b,'a>

Full name: Fleece.Fleece.Failure

--------------------
active recognizer Failure: Choice<'a,'b> -> Choice<'a,'b>

Full name: Fleece.Fleece.( |Success|Failure| )
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
module Events

from State.EventSource.DomainTypes
type RetrieveState =
  | InProgress
  | Error

Full name: State.EventSource.DomainTypes.Notification.RetrieveState
union case RetrieveState.InProgress: RetrieveState
union case RetrieveState.Error: RetrieveState
type SendApprovalState =
  | WaitingApproval
  | Approved

Full name: State.EventSource.DomainTypes.Notification.SendApprovalState
union case SendApprovalState.WaitingApproval: SendApprovalState
union case SendApprovalState.Approved: SendApprovalState
type SendState =
  | InProgress
  | Error

Full name: State.EventSource.DomainTypes.Notification.SendState
union case SendState.InProgress: SendState
union case SendState.Error: SendState
type NotificationState =
  | Nothing
  | Held of SendApprovalState
  | ReadyForRetrieve of SendApprovalState
  | Retrieving of RetrieveState * SendApprovalState
  | ReadyForSend of SendApprovalState
  | Sending
  | Complete
  | Error of string
  static member fold : state:NotificationState -> event:NotificationEvent -> NotificationState

Full name: State.EventSource.DomainTypes.Notification.NotificationState
union case NotificationState.Nothing: NotificationState
union case NotificationState.Held: SendApprovalState -> NotificationState
union case NotificationState.ReadyForRetrieve: SendApprovalState -> NotificationState
union case NotificationState.Retrieving: RetrieveState * SendApprovalState -> NotificationState
union case NotificationState.ReadyForSend: SendApprovalState -> NotificationState
union case NotificationState.Sending: NotificationState
union case NotificationState.Complete: NotificationState
union case NotificationState.Error: string -> NotificationState
static member NotificationState.fold : state:NotificationState -> event:NotificationEvent -> NotificationState

Full name: State.EventSource.DomainTypes.Notification.NotificationState.fold
val state : NotificationState
val event : NotificationEvent
union case NotificationEvent.NotificationCreated: Data.User -> NotificationEvent
union case NotificationEvent.RetrieveApproved: Data.User -> NotificationEvent
val sendApproval : SendApprovalState
union case NotificationEvent.SendApproved: Data.User -> NotificationEvent
val retrieveState : RetrieveState
module Audit

from State.EventSource.DomainTypes
type Auditors =
  {Creator: User;
   RetrieveAuthorisor: User option;
   SendAuthorisor: User option;}

Full name: State.EventSource.DomainTypes.Audit.Auditors
Auditors.Creator: User
Auditors.RetrieveAuthorisor: User option
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
Auditors.SendAuthorisor: User option
type AuditState =
  | Nothing
  | Error of string
  | Auditors of Auditors
  static member fold : state:AuditState -> event:NotificationEvent -> AuditState

Full name: State.EventSource.DomainTypes.Audit.AuditState
union case AuditState.Nothing: AuditState
union case AuditState.Error: string -> AuditState
Multiple items
union case AuditState.Auditors: Auditors -> AuditState

--------------------
type Auditors =
  {Creator: User;
   RetrieveAuthorisor: User option;
   SendAuthorisor: User option;}

Full name: State.EventSource.DomainTypes.Audit.Auditors
static member AuditState.fold : state:AuditState -> event:NotificationEvent -> AuditState

Full name: State.EventSource.DomainTypes.Audit.AuditState.fold
val state : AuditState
val user : User
union case Option.None: Option<'T>
val c : User
val s : User option
union case Option.Some: Value: 'T -> Option<'T>
val r : User option
Raw view Test code New version

More information

Link:http://fssnip.net/oE
Posted:10 years ago
Author:mavnn
Tags: event sourcing , fold

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.