Skip to content

Instantly share code, notes, and snippets.

@DejanMilicic
Forked from Savelenko/Program.fs
Created September 15, 2022 04:58
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save DejanMilicic/582698bb566a7cd44bf303405163a964 to your computer and use it in GitHub Desktop.
Save DejanMilicic/582698bb566a7cd44bf303405163a964 to your computer and use it in GitHub Desktop.
A modeling exercise in two acts with banning or verifying users in F# and the Onion architecture
(*
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 `VerifiedUser` belong to the model. Module `Application` 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 VerifiedUser =
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 Application =
open User
open VerifiedUser
type UserStore =
abstract LoadUser : UserId -> Option<User>
abstract LoadVerificationStatus : UserId -> Option<VerificationStatus>
abstract StoreVerificationStatus : User -> VerificationResult -> unit
let verifyUser (userStore : UserStore) (user : UserId) =
failwith "Implementation omitted, but must use f-n `verifyUser`."
(*
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-encoded variant of the same type
in the operation which "loads" verification status values indirectly.
*)
module VerifiedUser2 =
open System
open User
type VerificationStatus =
private
| Verified
| Banned
let verifyUser (user : User) : VerificationStatus =
let (UserName username) = user.UserName
if username.Contains 'Z' then Banned else Verified
/// Church-encoded variant of `VerificationStatus`.
type WithVerificationStatus<'result> = {
WithVerified : unit -> 'result
WithBanned : unit -> 'result
}
module Application2 =
open User
open VerifiedUser2
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) =
failwith "Implementation omitted, but must use f-n `verifyUser`."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment