F# : Event Sourcing in a nutshell

event-sourced-user.fsx

// ========= Event Sourcing in a nutshell

(*
    FriendlyName: string
        Aggregate friendly name.

    Initial: 'State
        Initial (empty) state we will start with.

    Decide: 'Command -> 'State -> 'Event list
        Given the current state and what has been requested, decide what should happen.

    Evolve: 'State -> 'Event -> 'State
        Given the current state and what happened, evolve to a new state.

    Build: 'State -> 'Event list -> 'State
        Given the current state and the history, build the state.

    Rebuild: 'Event list -> 'State
        Rebuild the current state from the entire history.
*)

// 1 ========= domain

module User =

    let FriendlyName = "User"

    // domain is identification agnostic, userId must never be present
    type Info =
        { Name: string
          Age: int
          Email: string }

    // events and commands should never leak out of the domain
    // they should be mapped to a dto if needed

    type Event =
        | Registered of Info
        | Verified
        | EmailModified of string

    type Command =
        | Register of Info
        | WasVerified
        | ModifyEmail of string

    // state is internal to the domain
    // depending on requirements it could be anything
    // as it's not stored, it could be fixed and replayed
    type State =
        { Registered: bool
          Verified: bool }

    let initialState =
        { Registered = false
          Verified = false }

    let private evolve state event =
        match event with
        | Registered _    -> { state with Registered = true }
        | Verified        -> { state with Verified = true }
        | EmailModified _ -> { state with Verified = false }

    let decide command state =
        match (command, state) with
        | Register userInfo, { Registered = false } -> [ Registered userInfo ]
        | WasVerified,       { Verified = false }   -> [ Verified ]
        | ModifyEmail email, { Registered = true }  -> [ EmailModified email ]
        | _ -> [ ] // could be some Result.Error instead

    let build = List.fold evolve
    let rebuild = build initialState

// 2 ========= application

module Handlers =

    let handleCommand 
        (read: unit -> User.Event list)
        (write: User.Event list -> unit)
        command
        =
        // command handler is pretty generic and could be shared
        let history = read ()
        let currentState = User.rebuild history
        let events = User.decide command currentState
        let state = User.build currentState events
        write events
        (events, state)

    // IRL, everything here must be idempotent
    // caution, avoid distributed transaction and instead prefer queueing by case
    let handleEvents
        (project: User.Event list -> User.State -> unit)
        (requestVerification: string -> unit)
        events state // state can be used for more complex scenarios
        =
        for event in events do
            match event with
            | User.Registered info     -> requestVerification info.Email
            | User.Verified            -> ()
            | User.EmailModified email -> requestVerification email
        project events state

module Projector =

    type UserModel =
        { Name: string
          Age: int
          Email: string
          Status: string }

    let project
        (addUser: UserModel -> unit)
        (updateEmail: string -> unit)
        (updateStatus: string -> unit)
        events state
        =
        for event in events do
            match event with
            | User.Registered info ->
                { Name = info.Name
                  Age = info.Age
                  Email = info.Email
                  Status = "pending" }
                |> addUser
            | User.Verified -> 
                updateStatus "ok"
            | User.EmailModified email ->
                updateEmail email
                updateStatus "pending"

// 3 ========= infra

type StreamKey =
    { FriendlyName: string
      FriendlyId: string }

module EventStore =
    // event store can be anything, depending on the context
    let db = System.Collections.Generic.Dictionary ()
    let read key =
        match db.TryGetValue key with
        | true, events -> events
        | _ -> []
    let write key events =
        let history = read key
        db.[key] <- history @ events

module ReadModel =
    // print functions could be database operations
    let addUser userId = printfn "user saved:\n%A"
    let updateEmail userId = printfn "email updated to %A"
    let updateStatus userId = printfn "status changed to %A"

module Mailing =
    let requestVerification = printfn "verification email sent to %A"

// 4 ========= startup

module Startup =

    let handleCommand userId =
        let key = { FriendlyName = User.FriendlyName; FriendlyId = userId }
        Handlers.handleCommand (fun () -> EventStore.read key) (EventStore.write key)

    let project userId =
        // dependencies could be a record of functions, if too large
        Projector.project
            (ReadModel.addUser userId)
            (ReadModel.updateEmail userId)
            (ReadModel.updateStatus userId)

    let handleEvents userId =
        Handlers.handleEvents (project userId) Mailing.requestVerification

    let handle userId command =
        // must be transactional
        handleCommand userId command
        ||> handleEvents userId

// demo

let userId = "abc123"

printfn "\n==== Register User"
User.Register { Name = "John Doe"; Age = 42; Email = "jdoe@veepee.com" }
|> Startup.handle userId

printfn "\n==== Was Verified"
User.WasVerified
|> Startup.handle userId

printfn "\n==== Email Changed"
User.ModifyEmail "john.doe@veepee.com"
|> Startup.handle userId

printfn "\n==== Was Verified"
User.WasVerified
|> Startup.handle userId

printfn "\n==== Event Store State"
EventStore.db
|> Seq.collect (fun kv -> kv.Value)
|> Seq.iteri (fun i v -> printfn "%i- %A" (i+1) v)

//> dotnet fsi event-sourced-user.fsx