A modeling exercise in two acts with banning or verifying users in F# and the Onion architecture

Program.fs

(*
An exercise in modeling. Users can be verified or banned. A user can be banned only if their username is "offensive".

We assume the Onion architecture. Modules `User` and `Verification` belong to the model. Module `UserVerification`
belongs to the application layer. Data access layer is omitted completely; it should be fairly trivial.

Note that the verified/banned aspect of a user is modeled "externally" to the notion of user itself. In particular,
there are no "aggregates" below which combine all aspects of a user.
*)

module User =

    type UserName = UserName of string

    type UserId = int

    type User = {
        Identifier : UserId
        UserName : UserName
    }

module Verification =
    
    open System
    open User

    type VerificationStatus =
        | Verified
        | Banned

    type VerificationResult = private VerificationResult of VerificationStatus

    let (|VerificationResult|) (VerificationResult r) = r

    let verifyUser (user : User) : VerificationResult =
        let (UserName username) = user.UserName
        if username.Contains 'Z' then VerificationResult Banned else VerificationResult Verified

module UserVerification =

    open User
    open Verification

    type UserStore =
        abstract LoadUser : UserId -> Option<User>
        abstract LoadVerificationStatus : UserId -> Option<VerificationStatus>
        abstract StoreVerificationStatus : User -> VerificationResult -> unit

    let verifyUser (userStore : UserStore) (user : UserId) =
        // Load the user (e.g. from the database)
        let user = userStore.LoadUser user |> Option.get // Dealing with `Option` is not the point of this example
        // Load the verification status of the user, if any
        match userStore.LoadVerificationStatus user.Identifier with
        | Some _ ->
            // Already verified (or banned), don't do anything
            ()
        | None ->
            // We need to verify (or ban) this user. We cannot just assign arbitrary verification status like below, it
            // will not compile:

            //userStore.StoreVerificationStatus user (VerificationResult Verified) // Compilation error here
            
            //Instead, business logic must be used here. There is no other way of obtaining a `VerificationResult`.
            let verificationResult = verifyUser user
            userStore.StoreVerificationStatus user verificationResult

module DataAccess =

    open User
    open Verification
    open UserVerification

    let userStoreDbRepository = { new UserStore with

        member _.LoadUser userId =
            // Nothing really interesting here, so only a sketch:
            let query = failwith "SELECT * FROM USER WHERE ..."
            query userId

        member _.LoadVerificationStatus userId =
            // Verification status for each user is stored in a separate table. There is a foreign key relationship
            // between this table and the `USER` table used in `LoadUser`. Actual status stored in the table can be
            // encoded in various ways. Here status values are stored as characters B and V for banned and verified
            // respectively. It's OK it you don't like it, it is not material for the main point of this example.
            let query = failwith "SELECT * FROM USER_VERIFICATION WHERE ..."
            let verificationStatus = query userId
            // Type `VerificationStatus` is completely public, so we can just construct its values directly based on the
            // result of the query and the meaning of the table as described above.
            match verificationStatus with
            | Some 'B' -> Some Banned
            | Some 'V' -> Some Verified
            | Some _ -> failwith "Unexpected DB value for `VerificationStatus`."
            | None -> None

        member _.StoreVerificationStatus user verificationResult =
            // We need to deal with `VerificationResult` in this member. It is an opaque (abstract) data type so we
            // cannot pattern match on its constructor. However the model layer provides convenient read-only access
            // using an active pattern. Use it to access the `VerificationStatus` value and store it in the same table
            // as used in `LoadVerificationStatus`. We ignore the possibility that the table already contains a record
            // for the user. An actual implementation would follow the "insert or update" pattern.
            let (VerificationResult verificationStatus) = verificationResult // Use the active pattern
            let query = failwith "INSERT INTO USER_VERIFICATION ..."
            // Pattern matching on `VerificationStatus` is possible because the type is completely public.
            match verificationStatus with
            | Banned -> query user.Identifier 'B'
            | Verified -> query user.Identifier 'V'
    }
    
(*
    PROPERTIES:

    - Application layer (AL) can freely load values of type `VerificationStatus` using operation
      `LoadVerificationStatus`.

    - In turn, data access layer (DAL) can easily implement `LoadVerificationStatus` because type `VerificationStatus`
      is completely public.

    - AL cannot assign (by storing) an arbitrary `VerificationStatus` to a `User`: operation `StoreVerificationStatus`
      requires a `VerificationResult` which is an opaque type and so the AL is forced to apply business logic by means
      of f-n `verifyUser`.

    - DAL can still easily implement `StoreVerificationStatus` because the model provides read-only access to
      `VerificationResult` by means of an active pattern (which is not that active in this case).

    DISCUSSION

    One can argue that AL could still circumvent business logic just by defining data access operation `StoreUserStatus`
    differently. In particular, by just ignoring type `VerificationResult` and using the public type
    `VerificationStatus` directly:

    member StoreVerificationStatus : User -> VerificationStatus -> unit.

    This is needlessly defensive thinking however. Namely, AL could do all kinds of crazy things which do not correspond
    to the specification of the system. Therefore we assume that (the programmer working on) AL is sane and uses the
    building blocks provided by the model properly.

    An alternative approach is of course possible if the reasoning above seems unsatisfactory. The main difference is
    that type `VerificationResult` is eliminated and we work with `VerificationStatus` directly. The type becomes opaque
    to (again) force the AL to apply business logic. However, loading of verification status values becomes difficult as
    DAL cannot simply use constructors of `VerificationStatus` anymore. We use a Church encoding-inspired scheme in the
    model and in the operation which "loads" verification status values indirectly.
*)

module Verification2 =
    
    open System
    open User

    type VerificationStatus =
        private // Note `private` here
        | Verified
        | Banned

    let verifyUser (user : User) : VerificationStatus =
        let (UserName username) = user.UserName
        if username.Contains 'Z' then Banned else Verified

    /// Church encoding-like continuations for computing values based on `VerificationStatus`.
    type WithVerificationStatus<'result> = {
        WithVerified : unit -> 'result
        WithBanned : unit -> 'result
    }

    /// A helper for working with `VerificationStatus` using Church encoding-like continuations.
    let verificationStatus (go : WithVerificationStatus<'result>) (status : VerificationStatus) : 'result =
        match status with
        | Verified -> go.WithVerified ()
        | Banned -> go.WithBanned ()

module UserVerification2 =

    open User
    open Verification2

    type UserStore =
        abstract LoadUser : UserId -> Option<User>
        abstract LoadVerificationStatus : UserId -> WithVerificationStatus<'result> -> Option<'result>
        abstract StoreVerificationStatus : User -> VerificationStatus -> unit

    let verifyUser (userStore : UserStore) (user : UserId) =
        // Load the user (e.g. from the database)
        let user = userStore.LoadUser user |> Option.get // Dealing with `Option` is not the point of this example
        // Load the verification status of the user, if any. More specifically, in this use-case we only want to know
        // _whether_ the user has been verified, not the actual verification status. Prepare a helper for this, as per
        // signature of `LoadVerificationStatus`.
        let isAlreadyVerified : WithVerificationStatus<unit> = {
            WithVerified = fun _ -> () // `unit` because we don't need to differentiate status, see above
            WithBanned = fun _ -> ()
        }
        // Actually load the verification status next
        match userStore.LoadVerificationStatus user.Identifier isAlreadyVerified with
        | Some alreadyVerified ->
            // Already verified (or banned), don't do anything
            alreadyVerified // Because `()` in `isAlreadyVerified` denotes both cases of "already verified or banned"
        | None ->
            // We need to verify (or ban) this user. We cannot just assign arbitrary verification status like below, it
            // will not compile:

            //userStore.StoreVerificationStatus user Verified // Compilation error here
            
            //Instead, business logic must be used here. There is no other way of obtaining a `VerificationStatus`.
            let verificationStatus = verifyUser user
            userStore.StoreVerificationStatus user verificationStatus

module DataAccess2 =

    open User
    open Verification2
    open UserVerification2

    let userStoreDbRepository = { new UserStore with
    
            member _.LoadUser userId =
                // Nothing really interesting here, so only a sketch:
                let query = failwith "SELECT * FROM USER WHERE ..."
                query userId
    
            member _.LoadVerificationStatus userId withStatus =
                // Verification status for each user is stored in a separate table. There is a foreign key relationship
                // between this table and the `USER` table used in `LoadUser`. Actual status stored in the table can be
                // encoded in various ways. Here status values are stored as characters B and V for banned and verified
                // respectively. It's OK it you don't like it, it is not material for the main point of this example.
                let query = failwith "SELECT * FROM USER_VERIFICATION WHERE ..."
                let verificationStatus = query userId
                // Type `VerificationStatus` is opaque (abstract) so we cannot construct its values here and just return
                // them. Instead, use continuations to "describe" the status to the caller. Note, that the caller
                // decides (chooses) what is computed by the continuations; it is completely unknown within this member.
                match verificationStatus with
                | Some 'B' -> Some (withStatus.WithBanned ())
                | Some 'V' -> Some (withStatus.WithVerified ())
                | Some _ -> failwith "Unexpected DB value for `VerificationStatus`."
                | None -> None
    
            member _.StoreVerificationStatus user verificationStatus =
                // We are passed a `VerificationStatus` here but cannot pattern match on it because it is an opaque
                // (abstract) data type. However, the model provides a Church encoding-like mechanism which we use here
                // similarly to how AL does it: define a helper which computes values to be stored in the verification
                // status table. We ignore the possibility that the table already contains a record for the
                // user. An actual implementation would follow the "insert or update" pattern.
                let dbEncoding : WithVerificationStatus<char> = {
                    WithVerified = fun _ -> 'V'
                    WithBanned = fun _ -> 'B'
                }
                let query = failwith "INSERT INTO USER_VERIFICATION ..."
                // Actually insert the verification status into the table after encoding it using the helper.
                query user.Identifier (Verification2.verificationStatus dbEncoding verificationStatus)                
        }

(*
    DISCUSSION

    Now that type `VerificationStatus` has private definition, both AL and DAL must use it via continuations packaged as
    `WithVerificationStatus<'result>`. It is clearly visible above how AL does it, by creating its own helper
    `isAlreadyVerified`. On the other hand, in order to persist a status DAL must somehow "pattern match" on it in the
    implementation of `StoreVerificationStatus`. As this is not possible directly due to constructor being private, DAL
    uses the `verificationStatus` helper provided by the model, similarly to what happens in AL.

    It is worth to mention explicitly that the DB schema in both approaches is the same. Compare the two DAL
    implementations next to each other to see this and that the difference is only in how data is "converted".
*)