lets-model-together.fs

(*
An exercise in modeling. Users can be verified or banned. A user can be banned only if their username is "offensive".
Additionally, we model the "initial" state of created user which is "unverified". Such user should be a subject of a specific action,
doing a verification.

Model consists of two concepts:
    * user details - keeping all information about CRUD-ish information
    * user - implicitly denoting status, utilizes user details to satisfy business rules (at the moment of writing - only one)

Possibly those two could be separated, so that `UserDetails` could grow in details (e.g. getting new fields as email, address, etc.),
whereas current `User` might not require more details to protect its invariants (a business rule on the username). Such separation
will help evolving two concepts freely, however, there's no need to do it right now.

We assume the Onion architecture. The strong requirement is to keep Domain "safe" from the technical jargon (without being a total purist - `Guid` is ok to use).

In order to be "persistence ignorant" on the sane level, Domain provides a contract in the form of repository pattern.

Sane level also means that it should be fairly straightforward to work with our Domain, from the infrastructure and application perspectives,
not losing the type inference and compile-time guarantees.

Thus a OO "Memento"-like approach is used (I called it `Snapshot`) - it means that higher level collaborators
can take snapshot of our domain concept (this can be treated as a "projection" from the given time) for persisting it somehow.

This is the most "dangerous" step, because one could easily take a snapshot and modify it, but it's not a domain concept that gets modified, but only the "projection".
Now it's where F# shines, because we can use Object expression to implement the snapshot on the fly, without exposing any implementation detail.

Experimentally, methods on Domain types were used, instead of functions within a module.
*)

module Domain =
    module User =
        open System
        type Username = Username of username: string
        with
            static member FromString(username: string): Username =
                Username username
            override this.ToString() =
                let (Username username) = this
                username

        type UserId = private UserId of id: Guid
        with 
            member this.ToGuid() =
                let (UserId guid) = this
                guid
            static member FromGuid(id: Guid) = UserId id

        // here we get "encapsulation", because all the fields are single case DUs,
        // keeping their invariants (actually now there are no invariants, but maybe in the future?)
        type UserDetails = {
            UserId: UserId
            Username: Username
        }

        [<Interface>]
        type UserSnapshot =
            abstract member Status : string
            abstract member Username: string
            abstract member UserId: Guid
    
        type UnverifiedUser = private UnverifiedUser of user: UserDetails
            with
                member this.ToSnapshot(): UserSnapshot =
                    let (UnverifiedUser user) = this
                    let (Username username) = user.Username
                    let (UserId userId) = user.UserId
                    {
                        new UserSnapshot with
                            member this.Status = "Unverified";
                            member this.Username = username;
                            member this.UserId = userId
                    }

                static member FromSnapshot(snapshot: UserSnapshot) =
                        let user = {
                                UserId = UserId snapshot.UserId;
                                Username = Username snapshot.Username;
                            }
                        UnverifiedUser user

                member this.Id =
                    let (UnverifiedUser (user)) = this
                    user.UserId.ToGuid()

        and UserAfterVerification =
            private 
            | Verified of user: UserDetails
            | Banned of user: UserDetails
                with
                    member this.Id =
                        match this with
                        | (Verified (user)) ->
                            let (UserId id) = user.UserId
                            id
                        | (Banned (user)) ->
                            let (UserId id) = user.UserId
                            id
                    member this.ToSnapshot(): UserSnapshot =
                        let name = match this with
                                    | Verified (user) ->
                                        user.Username.ToString()
                                    | Banned user -> 
                                        user.Username.ToString()
                        let userId = match this with
                                        | Verified (user) ->
                                            user.UserId.ToGuid()
                                        | Banned (user) ->
                                            user.UserId.ToGuid()
                                            
                        let status = match this with
                                        | Verified _ -> "Verified"
                                        | Banned _ -> "Banned"
                        {
                            new UserSnapshot with
                                member this.Status = status
                                member this.UserId = userId
                                member this.Username = name
                        }
                    
                    static member FromSnapshot(snapshot: UserSnapshot) =
                        let user = {
                            UserId = UserId snapshot.UserId;
                            Username = Username snapshot.Username;
                        }
                        match snapshot.Status with
                        | "Verified" -> Verified user |> Ok
                        | "Banned" -> Banned user |> Ok
                        | _ -> Error $"Unexpected user status {snapshot.Status}"

        
        type CreateUser = string -> UnverifiedUser
        let createUser': CreateUser = fun username ->
            let newId = Guid.NewGuid() |> UserId
            let user = {
                Username = Username username;
                UserId = newId
            }

            UnverifiedUser user

        type VerifyUser = UnverifiedUser -> UserAfterVerification
        let verifyUser': VerifyUser = fun (UnverifiedUser user) ->
            let (Username username) = user.Username
            if username.Contains "Z"
                then Banned user
                else Verified user

        [<Interface>]
        type IUserRepository =
            abstract member Save: UserAfterVerification -> Option<Guid>
            abstract member Save: UnverifiedUser -> Option<Guid>
            abstract member LoadUnverifiedUser: Guid -> Option<UnverifiedUser>
            abstract member LoadUser: Guid -> Option<UserAfterVerification>

[<RequireQualifiedAccess>]
module Application = 
        open Domain.User
        open System

        type VerifyUser = IUserRepository -> UserId -> Option<UserAfterVerification>
        let verifyUser: VerifyUser = fun repository userId ->
            let user = repository.LoadUnverifiedUser (userId.ToGuid())

            let user = 
                user
                |> Option.map verifyUser'

            user
            |> Option.bind repository.Save
            |> ignore

            user

        type CreateUser = IUserRepository -> string -> Option<Guid>
        let createUser: CreateUser = fun repository username ->
            let user = createUser' username

            repository.Save user

        
module Infrastructure = 
        open Domain.User
        open System.Collections.Generic
        open System.Linq
        open System
        
        // our "database"
        let users: Dictionary<Guid, UserSnapshot> = new Dictionary<Guid, UserSnapshot>()
        let inMemoryRepository =
            {
                new IUserRepository with
                    member this.Save(unverifiedUser: UnverifiedUser): Option<Guid> = 
                        users[unverifiedUser.Id] <- unverifiedUser.ToSnapshot()

                        unverifiedUser.Id |> Some
                    member this.LoadUnverifiedUser(userId: Guid): Option<Domain.User.UnverifiedUser> = 
                        if users.ContainsKey userId
                            then users[userId] |> UnverifiedUser.FromSnapshot |> Some
                            else None
                    member this.LoadUser(userId: Guid): Option<UserAfterVerification> = 
                        if users.ContainsKey userId
                            then users[userId] 
                                    |> UserAfterVerification.FromSnapshot
                                    |> function
                                        | Ok user -> Some user
                                        | Error err -> None

                            else None
                    member this.Save(user: UserAfterVerification): Option<Guid> = 
                        users[user.Id] <- user.ToSnapshot()

                        user.Id |> Some
            }

        module Queries =
            type GetAllVerifiedUsers = unit -> {| UserId: Guid; Username: string|} array
            let getAllVerifiedUsers: GetAllVerifiedUsers = fun () ->
                let users' = users.Values.ToArray()

                users'
                |> Array.filter (fun (snapshot: UserSnapshot) -> snapshot.Status = "Verified")
                |> Array.map (fun (snapshot: UserSnapshot) -> {| UserId = snapshot.UserId; Username = snapshot.Username |})
            
            type GetAllBannedUsers = unit -> {| UserId: Guid; Username: string|} array
            let getAllBannedUsers: GetAllBannedUsers = fun () ->
                let users' = users.Values.ToArray()

                users'
                |> Array.filter (fun (snapshot: UserSnapshot) -> snapshot.Status = "Banned")
                |> Array.map (fun (snapshot: UserSnapshot) -> {| UserId = snapshot.UserId; Username = snapshot.Username |})

open Infrastructure
open Domain.User

let createUserWithDi = Application.createUser inMemoryRepository
let verifyUserWithDi = Application.verifyUser inMemoryRepository

let user1 = createUserWithDi "damian"
user1
|> Option.map (fun id' ->
    verifyUserWithDi (id' |> UserId.FromGuid)
)

let user2 = createUserWithDi "damianZ"
user2
|> Option.map (fun id' ->
    verifyUserWithDi (id' |> UserId.FromGuid)
)

let snapshot1: UserSnapshot = (user1 |> Option.bind inMemoryRepository.LoadUser).Value.ToSnapshot()
// Those two does not compile:
// let modifiedSnapshot1 = { snapshot1 with Status = "Banned"}
// snapshot1.Status <- "Banned"
user2 |> Option.bind inMemoryRepository.LoadUser

Infrastructure.Queries.getAllVerifiedUsers()
Infrastructure.Queries.getAllBannedUsers()

(*
    DISCUSSION:
    A healthy mixture of OO and FP provided a "good enough" approach to Onion architecture and modeling experiment:
        - we protect the domain in compile-time while making it easy to work with it on other levels
        - F# object expression is very handy to provide snapshots of our domain model
        - we are able to express behavior by precise usage of types
*)