Wiring a ViewModel to a DDD-Workflow

Intro

I recently connected a viewmodel to a workflow that I was inspired to write as a result of reading the book: Domain Driven Design Made Functional. All of my source code can be found on GitHub/Nikeza.

ViewModel

In the viewmodel, I handle validating and submitting a form. The interesting part of this exercise is that I receive domain events as a response to requesting validation and submission.

Here’s the logic for validating and submitting a form:

type ViewModel() as x =

    let mutable validatedForm = None

    let eventOccurred = new Event<_>()

    let validate() =
        let isValidated = function
            | FormValidated form -> validatedForm <- Some form; true
            | _ -> false

        { Form.Email=    x.Email
          Form.Password= x.Password
          Form.Confirm=  x.Confirm
        } 
        |> ofUnvalidated
        |> Validate.Execute 
        |> In.ValidateRegistration.workflow
        |> Updates.statusOf isValidated
               
    let submit() =
        let publishEvents events =
            events |> List.iter(fun event -> eventOccurred.Trigger(event))

        validatedForm |> function 
                         | Some form -> 
                                form |> Submit.Execute 
                                     |> In.SubmitRegistration.workflow
                                     |> publishEvents
                         | None -> ()

    let validateCommand = DelegateCommand( (fun _ -> x.IsValidated <- validate()) , fun _ -> true)

    let submitCommand =   DelegateCommand( (fun _ -> submit() |> ignore), 
                                            fun _ -> x.IsValidated <- validate(); x.IsValidated )

    let mutable email =    ""
    let mutable password = ""
    let mutable confirm =  ""
    let mutable isValidated = false

    member x.Validate = validateCommand :> ICommand
    member x.Submit =   submitCommand   :> ICommand

    [<CLIEvent>]
    member x.EventOccured = eventOccurred.Publish

The remaining viewmodel is the following:

type ViewModel() as x =

    ...
    member x.Email
             with get() =      email
             and  set(value) = email <- value

    member x.Password
             with get() =      password
             and  set(value) = password <- value

    member x.Confirm
        with get() =      confirm
        and  set(value) = confirm <- value

    member x.IsValidated
             with get() =      isValidated
             and  set(value) = isValidated <- value

Here’s some viewmodel helpers:

type UIForm = Registration.Types.Form
type DomainForm = Nikeza.Mobile.Profile.Registration.Form

module That =
    let generatesPage events =
        let eventToPage = function
        | RegistrationSucceeded _ -> () // displayPortal()
        | RegistrationFailed    _ -> () // displayError()

        events |> List.iter eventToPage

module Updates =
    let statusOf formValidated events =
        events |> List.exists formValidated

Registration Workflow

Here’s the Registration workflow:

module In

open Nikeza.Mobile.Profile.Commands
open Nikeza.Mobile.Profile.Commands.Registration
open Nikeza.Mobile.Profile.Events
open Logic

module SubmitRegistration =
    type private SubmitWorkflow = Submit -> RegistrationSubmissionEvent list

    let workflow : SubmitWorkflow =
        fun command -> command |> function
            Submit.Execute form ->
                form |> Try.submit
                     |> ResultOf.Submit.Executed
                     |> Are.Registration.Submission.events

module ValidateRegistration =
    type private ValidateWorkflow = Validate -> RegistrationValidationEvent list

    let workflow : ValidateWorkflow =
        fun command -> command |> function
            Validate.Execute form ->
                             form |> Registration.validate
                                  |> ResultOf.Validation.Executed
                                  |> Are.Registration.Validation.events

Domain Events

The domain events are structured as follows:

module Nikeza.Mobile.Profile.Events

open Nikeza.Common
open Nikeza.DataTransfer

type UnvalidatedForm = Nikeza.Mobile.Profile.Registration.UnvalidatedForm
type ValidatedForm =   Nikeza.Mobile.Profile.Registration.ValidatedForm

type RegistrationValidationEvent =
    | FormValidated         of ValidatedForm
    | FormNotValidated      of UnvalidatedForm

type RegistrationSubmissionEvent =
    | RegistrationSucceeded of Profile
    | RegistrationFailed    of ValidatedForm

Here’s how these events get emitted:

module internal Are.Registration

open Nikeza.Mobile.Profile.Commands
open Nikeza.Mobile.Profile.Events

module Submission =
    type private RegistrationSubmission = ResultOf.Submit -> RegistrationSubmissionEvent list

    let events : RegistrationSubmission =
        fun resultOf -> 
            resultOf |> function
                        ResultOf.Submit.Executed result -> 
                                                 result |> function
                                                         | Ok    profile -> [ RegistrationSucceeded profile]
                                                         | Error form    -> [ RegistrationFailed    form ]

module Validation =
    type private RegistrationValidation = ResultOf.Validation -> RegistrationValidationEvent list

    let events : RegistrationValidation =
        fun resultOf -> 
            resultOf |> function
                        ResultOf.Validation.Executed result -> 
                                                     result |> function
                                                               | Error form -> [FormNotValidated form]
                                                               | Ok    form -> [FormValidated    form]

Tests

Here’s the test that I wrote:

module Tests.Registration

open FsUnit
open NUnit.Framework
open Nikeza.Mobile.UILogic.Registration
open TestAPI
open Nikeza.Mobile.Profile.Events

[<Test>]
let ``Registration validated with email and matching passwords`` () =
    
    // Setup
    let registration = ViewModel()
    registration.Email    <- someEmail
    registration.Password <- somePassword
    registration.Confirm  <- somePassword

    // Test
    registration.Validate.Execute()

    // Verify
    registration.IsValidated |> should equal true

[<Test>]
let ``Registration submitted after being validated`` () =
    
    // Setup
    let mutable registrationSucceeded = false

    let registration = ViewModel()
    Apply.valuesTo registration

    registration.EventOccured.Add(fun event -> 
                                      event |> function
                                               | RegistrationSucceeded _ -> registrationSucceeded <- true
                                               | RegistrationFailed    _ -> registrationSucceeded <- false)
    registration.Validate.Execute()

    // Test
    registration.Submit.Execute()

    // Verify
    registrationSucceeded |> should equal true

 

Advertisements

Elm: Implementing a User Control

Intro

This post attempts to document my journey of building a user-control in Elm. The user-control that I’m building is a login control.

Building the Login Control

The following is the code for the Login control:

module Domain.Login exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)

-- MODEL

type alias Model =
    { username : String
    , password : String
    , loggedIn : Bool
    }

model : Model
model =
    Model "" "" False

-- UPDATE

type Msg
    = UserInput String
    | PasswordInput String
    | Attempt ( String, String )

update : Msg -> Model -> Model
update msg model =
    case msg of
        UserInput v ->
            { model | username = v }

        PasswordInput v ->
            { model | password = v }

        Attempt ( username, password ) ->
            if String.toLower username == "test" && String.toLower password == "test" then
                { model | loggedIn = True }
            else
                { model | loggedIn = False }

-- VIEW

view : Model -> Html Msg
view model =
    div []
        [ input [ class "signin", type_ "submit", value "Signin", onClick <| Attempt ( model.username, model.password ) ] []         , input [ class "signin", type_ "password", placeholder "password", onInput PasswordInput, value model.password ] []         , input [ class "signin", type_ "text", placeholder "username", onInput UserInput, value model.username ] []         ] 

Note that we have the following messages within the code above:

 type Msg     = UserInput String     | PasswordInput String     | Attempt ( String, String ) 

The messages (i.e. union cases) above that have their own attached data are used to update the state of our Login model. Therefore, we can examine the code below to understand observe how the messages get sent:

 view : Model -> Html Msg
view model =
    div []
        [ input [ class "signin", type_ "submit", value "Signin", onClick <| Attempt ( model.username, model.password ) ] []
        , input [ class "signin", type_ "password", placeholder "password", onInput PasswordInput, value model.password ] []
        , input [ class "signin", type_ "text", placeholder "username", onInput UserInput, value model.username ] []
        ]

Note that the code for the Login control follows the standard structure of Elm’s (Model, View, Update) architecture. Hence, there’s no new paradigm being introduced for that code. However, there is a little bit of ceremony within the parent control that will embed the login control.

Embedding the User Control

The following code reflects the parent control of the Login control:

module Home exposing (..)

import Domain.Core exposing (..)
import Domain.Login as Login exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)

main =
    Html.beginnerProgram
        { model = model
        , update = update
        , view = view
        }

-- MODEL

type alias Model =
    { videos : List Video
    , articles : List Article
    , login : Login.Model
    }

model : Model
model =
    { videos = [], articles = [], login = Login.model }

init : ( Model, Cmd Msg )
init =
    ( model, Cmd.none )

-- UPDATE

type Msg
    = Video Video
    | Article Article
    | Submitter Submitter
    | Search String
    | Register
    | Login Login.Msg

update : Msg -> Model -> Model
update msg model =
    case msg of
        Video v ->
            model

        Article v ->
            model

        Submitter v ->
            model

        Search v ->
            model

        Register ->
            model

        Login subMsg ->
            let
                newState =
                    Login.update subMsg model.login
            in
                { model | login = newState }

-- VIEW

view : Model -> Html Msg
view model =
    div []
        [ header []
            [ label [] [ text "Nikeza" ]
            , model |> sessionUI
            ]
        , footer [ class "copyright" ]
            [ label [] [ text "(c)2017" ]
            , a [href ] [ text "GitHub" ]
            ]
        ]

sessionUI : Model -> Html Msg
sessionUI model =
    let
        loggedIn =
            model.login.loggedIn

        welcome =
            p [] [ text <| "Welcome " ++ model.login.username ++ "!" ]

        signout =
            a [ href "" ] [ label [] [ text "Signout" ] ]
    in
        if (not loggedIn) then
            Html.map Login <| Login.view model.login
        else
            div [ class "signin" ] [ welcome, signout ]

Let’s first break down the plumbing required for the parent control to use the embedded Login control.

Model

We add a property (i.e. login) to our Model record that is of type Login.Model which is defined within our embedded Login user-control.

Here’s the code:

type alias Model =
    { videos : List Video
    , articles : List Article
    , login : Login.Model
    }

Message

Our parent control needs to define a message case that correlates to the message type that’s defined within the embedded Login control.

Here’s the code:

type Msg
    = ...
    | Login Login.Msg

So in the discriminated union above (i.e. Msg), we declared a message case value named “Login” and associate an argument of type Msg that references the embedded Login control’s Msg type.

Update

Once our message case value is declared (which references the Msg type of the Login control), we then write code for our Update function on our parent control.

Here’s the code:

update : Msg -> Model -> Model
update msg model =
    case msg of
        ...
        Login subMsg ->
            let
                newState =
                    Login.update subMsg model.login
            in
                { model | login = newState }

The code above takes the value of our “Login” case value and applies it to the Update function of the Login module along with the required model argument.

View

In order for the view to embed the Login user-control, we take leverage the Html.map function. In the Html.map function we supply the message and the result from invoking the user-control’s view function. When invoking the view function, we provide the login property of our parent’s model.

Here’s the code:

sessionUI : Model -> Html Msg
sessionUI model =
    let
        loggedIn =
            model.login.loggedIn

        welcome =
            p [] [ text <| "Welcome " ++ model.login.username ++ "!" ]

        signout =
            a [ href "" ] [ label [] [ text "Signout" ] ]
    in
        if (not loggedIn) then
            Html.map OnLogin <| Login.view model.login
        else
            div [ class "signin" ] [ welcome, signout ]

Conclusion

In conclusion, I attempted to document my journey of building a user control in Elm.

F#: Akka.Net (Cluster.Sharding)

Intro

This post is intended to document my current understanding of the Cluster.Sharding feature within Akka.Net. This feature is in pre-release as of 3/17/2017.

I identified from this documentation that a cluster represents a fault-tolerant, elastic, decentralized, peer-to-peer network of programs. The Akka.Net framework provides a library that supports creating and managing a cluster.

Akka.Cluster.Sharding

Akkling.Cluster.Sharding is an open-source library that provides F# support for an Akka.NET cluster. I discovered this library after posting questions on stackoverflow.

Within Akka.Net, there are four terms that are essential for understanding how to implement a cluster using Akka.NET:

  • Node
  • Shard
  • ShardRegion
  • Entity

What is a Node?

I assume a node is a service identified by the combination of a server address and port number that contain one or more shards.

What is a Shard?

A shard is a group of entities that are managed together within a clustered system.

What is a ShardRegion?

A shard region is responsible for locating the shard of an entity as well as delivering messages to an entity. In the event that an entity is not available to receive a message, the ShardRegion will spawn a new entity so that it can deliver its message.

What is an Entity?

An entity is essentially an actor that belongs to a cluster. However, in order to locate an entity, the shard region of that entity needs to be identified.

Sample Code

I took the sample code from the Akkling repo and made minor changes:

open System
open System.IO
#if INTERACTIVE
let cd = Path.Combine(__SOURCE_DIRECTORY__, "../src/Akkling.Cluster.Sharding/bin/Debug")
System.IO.Directory.SetCurrentDirectory(cd)
#endif

#r "../src/Akkling.Cluster.Sharding/bin/Debug/System.Collections.Immutable.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Hyperion.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Newtonsoft.Json.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/FSharp.PowerPack.Linq.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Helios.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/FsPickler.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Google.ProtocolBuffers.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Google.ProtocolBuffers.Serialization.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Remote.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Google.ProtocolBuffers.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Persistence.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Cluster.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Cluster.Tools.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Cluster.Sharding.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akka.Serialization.Hyperion.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akkling.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akkling.Persistence.dll"
#r "../src/Akkling.Cluster.Sharding/bin/Debug/Akkling.Cluster.Sharding.dll"

open Akka.Actor
open Akka.Configuration
open Akka.Cluster
open Akka.Cluster.Tools.Singleton
open Akka.Cluster.Sharding
open Akka.Persistence

open Akkling
open Akkling.Persistence
open Akkling.Cluster
open Akkling.Cluster.Sharding
open Hyperion

let configWithPort port =
    let config = Configuration.parse ("""
        akka {
            actor {
              provider = "Akka.Cluster.ClusterActorRefProvider, Akka.Cluster"
              serializers {
                hyperion = "Akka.Serialization.HyperionSerializer, Akka.Serialization.Hyperion"
              }
              serialization-bindings {
                "System.Object" = hyperion
              }
            }
          remote {
            helios.tcp {
              public-hostname = "localhost"
              hostname = "localhost"
              port = """ + port.ToString() + """
            }
          }
          cluster {
            auto-down-unreachable-after = 5s
            seed-nodes = [ "akka.tcp://cluster-system@localhost:2551/" ]
          }
          persistence {
            journal.plugin = "akka.persistence.journal.inmem"
            snapshot-store.plugin = "akka.persistence.snapshot-store.local"
          }
        }
        """)
    config.WithFallback(ClusterSingletonManager.DefaultConfig())
 
let consumer (actor:Actor<_>) msg = printfn "\n%A received %s" (actor.Self.Path.ToStringWithAddress()) msg |> ignored
 
// spawn two separate systems with shard regions on each of them
 
let system1 = System.create "cluster-system" (configWithPort 2551)
let shardRegion1 = spawnSharded id system1 "printer" <| props (actorOf2 consumer)
 
// wait a while before starting a second system
System.Threading.Thread.Sleep(3000)
let system2 = System.create "cluster-system" (configWithPort 2552)
let shardRegion2 = spawnSharded id system2 "printer" <| props (actorOf2 consumer)
 
// send hello world to entities on 4 different shards (this means that we will have 4 entities in total)
// NOTE: even thou we sent all messages through single shard region,
//       some of them will be executed on the second one thanks to shard balancing
System.Threading.Thread.Sleep(3000)
shardRegion1 <! ("shard-1", "entity-1", "hello world 1")
shardRegion1 <! ("shard-2", "entity-2", "hello world 2")
shardRegion1 <! ("shard-1", "entity-3", "hello world 3")
shardRegion1 <! ("shard-2", "entity-4", "hello world 4")
 
// check which shards have been build on the second shard region
 
System.Threading.Thread.Sleep(3000)
 
open Akka.Cluster.Sharding
 
let printShards shardRegion =
    async {
        let! reply = (retype shardRegion) <? GetShardRegionStats.Instance         
        let (stats: ShardRegionStats) = reply.Value         
        for kv in stats.Stats do             
            printfn "\tShard '%s' has %d entities on it" kv.Key kv.Value     
    } |> Async.RunSynchronously
 
printfn "\nShards active on node 'localhost:2551':"
printShards shardRegion1
printfn "\nShards active on node 'localhost:2552':"
printShards shardRegion2

The output is the following:

Binding session to 'C:\Users\Snimrod\Desktop\Akkling-master\examples\../src/Akkling.Cluster.Sharding/bin/Debug/Akka.dll'...
Binding session to 'C:\Users\Snimrod\Desktop\Akkling-master\examples\../src/Akkling.Cluster.Sharding/bin/Debug/System.Collections.Immutable.dll'...
[INFO][3/15/2017 2:58:16 PM][Thread 0001][remoting] Starting remoting
[INFO][3/15/2017 2:58:16 PM][Thread 0001][remoting] Remoting started; listening on addresses : [akka.tcp://cluster-system@localhost:2551]
[INFO][3/15/2017 2:58:16 PM][Thread 0001][remoting] Remoting now listens on addresses: [akka.tcp://cluster-system@localhost:2551]
[INFO][3/15/2017 2:58:16 PM][Thread 0001][Cluster] Cluster Node [akka.tcp://cluster-system@localhost:2551] - Starting up...
[INFO][3/15/2017 2:58:16 PM][Thread 0001][Cluster] Cluster Node [akka.tcp://cluster-system@localhost:2551] - Started up successfully
[INFO][3/15/2017 2:58:16 PM][Thread 0007][[akka://cluster-system/system/cluster/core/daemon#1110691120]] Node [akka.tcp://cluster-system@localhost:2551] is JOINING, roles []
[INFO][3/15/2017 2:58:16 PM][Thread 0007][[akka://cluster-system/system/cluster/core/daemon#1110691120]] Leader is moving node [akka.tcp://cluster-system@localhost:2551] to [Up]
[INFO][3/15/2017 2:58:16 PM][Thread 0007][akka://cluster-system/user/sharding/printerCoordinator/singleton/coordinator] Message Register from akka://cluster-system/user/sharding/printer to akka://cluster-system/user/sharding/printerCoordinator/singleton/coordinator was not delivered. 1 dead letters encountered.
[INFO][3/15/2017 2:58:16 PM][Thread 0004][[akka://cluster-system/user/sharding/printerCoordinator#643222226]] Singleton manager [akka.tcp://cluster-system@localhost:2551] starting singleton actor
[INFO][3/15/2017 2:58:16 PM][Thread 0004][[akka://cluster-system/user/sharding/printerCoordinator#643222226]] ClusterSingletonManager state change [Start -> Oldest] Akka.Cluster.Tools.Singleton.Uninitialized
[INFO][3/15/2017 2:58:19 PM][Thread 0001][remoting] Starting remoting
[INFO][3/15/2017 2:58:19 PM][Thread 0001][remoting] Remoting started; listening on addresses : [akka.tcp://cluster-system@localhost:2552]
[INFO][3/15/2017 2:58:19 PM][Thread 0001][remoting] Remoting now listens on addresses: [akka.tcp://cluster-system@localhost:2552]
[INFO][3/15/2017 2:58:19 PM][Thread 0001][Cluster] Cluster Node [akka.tcp://cluster-system@localhost:2552] - Starting up...
[INFO][3/15/2017 2:58:19 PM][Thread 0001][Cluster] Cluster Node [akka.tcp://cluster-system@localhost:2552] - Started up successfully
[INFO][3/15/2017 2:58:19 PM][Thread 0008][[akka://cluster-system/system/cluster/core/daemon#1110691120]] Node [akka.tcp://cluster-system@localhost:2552] is JOINING, roles []
[INFO][3/15/2017 2:58:20 PM][Thread 0004][[akka://cluster-system/system/cluster/core/daemon#205575170]] Welcome from [akka.tcp://cluster-system@localhost:2551]
[INFO][3/15/2017 2:58:20 PM][Thread 0006][[akka://cluster-system/system/cluster/core/daemon#1110691120]] Leader is moving node [akka.tcp://cluster-system@localhost:2552] to [Up]
[INFO][3/15/2017 2:58:20 PM][Thread 0008][[akka://cluster-system/user/sharding/printerCoordinator#1529090680]] ClusterSingletonManager state change [Start -> Younger] Akka.Cluster.Tools.Singleton.Uninitialized

"akka://cluster-system/user/sharding/printer/shard-1/entity-1" received hello world 1

"akka://cluster-system/user/sharding/printer/shard-2/entity-2" received hello world 2

"akka://cluster-system/user/sharding/printer/shard-1/entity-3" received hello world 3

"akka://cluster-system/user/sharding/printer/shard-2/entity-4" received hello world 4

Shards active on node 'localhost:2551':
	Shard 'shard-2' has 2 entities on it

Shards active on node 'localhost:2552':
	Shard 'shard-1' has 2 entities on it

The code that does messaging was the following:

shardRegion1 <! ("shard-1", "entity-1", "hello world 1")
shardRegion1 <! ("shard-2", "entity-2", "hello world 2")
shardRegion1 <! ("shard-1", "entity-3", "hello world 3")
shardRegion1 <! ("shard-2", "entity-4", "hello world 4")

Note how the lines above are all addressing the same shard (i.e. shardRegion1). However, Shard Balancing will attempt to dispatch messages such that they are evenly distributed across shards.

In addition, if we append shard-3 below:

System.Threading.Thread.Sleep(3000)
shardRegion1 <! ("shard-1", "entity-1", "hello world 1")
shardRegion1 <! ("shard-2", "entity-2", "hello world 2")
shardRegion1 <! ("shard-1", "entity-3", "hello world 3")
shardRegion1 <! ("shard-2", "entity-4", "hello world 4")

shardRegion1 <! ("shard-3", "entity-5", "hello world 4")

Then we can observe an update within our nodes on the cluster:

"akka://cluster-system/user/sharding/printer/shard-1/entity-3" received hello world 3

"akka://cluster-system/user/sharding/printer/shard-3/entity-5" received hello world 4

"akka://cluster-system/user/sharding/printer/shard-1/entity-1" received hello world 1

"akka://cluster-system/user/sharding/printer/shard-2/entity-2" received hello world 2

"akka://cluster-system/user/sharding/printer/shard-2/entity-4" received hello world 4

Shards active on node 'localhost:2551':
	Shard 'shard-3' has 1 entities on it
	Shard 'shard-1' has 2 entities on it

Shards active on node 'localhost:2552':
	Shard 'shard-2' has 2 entities on it

Conclusion

The End.

F#: Computation Expressions (Bank Account Kata)

I have been avoiding the concept of Monads in my journey to learn F#. However, I know that sooner or later, I’m just going to have to man-up. As a result, I have been trying to qualify the need to leverage F#’s Computation Expression.

My current conclusion is that a Computation Expression within F# can enable a developer to implement cross-cutting concerns all within a unit of code that maintains functional plug & play within a functional domain model.

I implemented a sample Computation Expression below that handles security and logging:

(*Types*)
type UserName =  UserName  of string
type Password =  Password  of string
type FirstName = FirstName of string
type LastName =  LastName  of string
type Balance =   Balance   of decimal
 
type Credentials = { UserName:UserName;   Password:Password }
type Account =     { FirstName:FirstName; LastName:LastName; Balance:Balance }
 
type GetAuthenticationBuilder() =
    member this.Bind (credentials, f) = printf "Logged In: %A\n\n" credentials; f credentials
    member this.Return x   = x
 
(*Functions*) 
let getAuthentication = GetAuthenticationBuilder()
let authenticate credentials = 
    getAuthentication { 
        let! result = if credentials.UserName = UserName "Bizmonger"  &&
                         credentials.Password = Password "MyPassword"

                      then Some { FirstName=FirstName "Scott"
                                  LastName= LastName  "Nimrod"
                                  Balance=  Balance    99.99m }
                      else printf "Authentication failed: %A" credentials
                           None 
        return result }

Here’s the client that fails to authenticate:


(*Client*)
let result = { UserName= UserName "Bizmonger"
               Password= Password "LA LA LA Mutha #$%^!" } |> authenticate

Here’s the output below:

> 
Authentication failed: {UserName = UserName "Bizmonger";
 Password = Password "LA LA LA Mutha #$%^!";}Logged In: <null>


val result : Account option = None

> 

What’s interesting about the results above is that it appears that the Bind method of the GetAuthenticationBuilder gets invoked AFTER the primary expression’s execution.

Here’s a client that DOES authenticate:


(*Client*)
let result = { UserName= UserName "Bizmonger"
               Password= Password "MyPassword" } |> authenticate

Here’s the output:

> 
Logged In: Some {FirstName = FirstName "Scott";
      LastName = LastName "Nimrod";
      Balance = Balance 99.99M;}


val result : Account option = Some {FirstName = FirstName "Scott";
                                    LastName = LastName "Nimrod";
                                    Balance = Balance 99.99M;}

>