Snippets to https://bartoszsypytkowski.com/dealing-with-complex-dependency-injection-in-f/

Demo1.fs

// #r "nuget: Ply"
// #r "nuget: BCrypt.Net-Next"

module FsDemo.Demo1

open System
open System.Text
open System.Threading.Tasks
open FSharp.Control.Tasks.Builders

[<Interface>]
type ILogger =
    abstract Info: string -> unit
    abstract Error: string -> unit
    
[<Interface>]
type ILog = abstract Logger: ILogger

module Log =
    let info (env: #ILog) fmt = Printf.kprintf env.Logger.Info fmt
    let error (env: #ILog) fmt = Printf.kprintf env.Logger.Error fmt
    
[<Interface>]
type IDatabase =
    abstract Query: string * 'i -> Task<'o>
    abstract Execute: string * 'i -> Task
    
[<Interface>]
type IDb = abstract Database: IDatabase

module Db =
    module Queries =
        let FetchUser = "SELECT * FROM users WHERE UserId = @userId"
        let UpdateUser = "UPDATE users SET Hash = @Hash, Salt = @Salt WHERE UserId = @userId"
    
    let fetchUser (env: #IDb) userId = env.Database.Query(Queries.FetchUser, {| userId = userId |})
    let updateUser (env: #IDb) user = env.Database.Execute(Queries.UpdateUser, user)
    
[<Interface>]
type IRandom = abstract Random: Random

module Random = 
    let bytes (env: #IRandom) count =
        let array = Array.zeroCreate count
        env.Random.NextBytes array
        array
        
    let string (env: #IRandom) count =
        BitConverter.ToString <| bytes env count
        
        
type User = { Id: int; Name: string; Hash: string; Salt: string }
type ChangePassReq = { UserId: int; OldPass: string; NewPass: string }
        
let bcrypt salt password = BCrypt.Net.BCrypt.HashPassword(password, salt)
     
(* --------- TEST APP --------- *)   
     
module App =
            
    let changePass env = fun req -> task {
        let! user = Db.fetchUser env req.UserId
        if user.Hash = bcrypt user.Salt req.OldPass then
            let salt = Random.string env 32
            do! Db.updateUser env { user with Salt = salt; Hash = bcrypt salt req.NewPass }
            Log.info env "Changed password for user %i" user.Id
            return Ok ()
        else 
            Log.error env "Password change unauthorized: user %i" user.Id
            return Error "Old password is invalid"
    }
    
    [<Sealed>]
    type Env() =
        interface IRandom with member _.Random = failwith "not implemented"
        interface IDb with member _.Database = failwith "not implemented"
        interface ILog with member _.Logger = failwith "not implemented"
        interface IDisposable with member _.Dispose() = () // cleanup resources
    
(* --------- RUN --------- *)
    
let run () = task {
    use env = new App.Env ()
    let req = { UserId = 1; OldPass = "admin123"; NewPass = "admin234" }
    return! App.changePass env req
}

Demo2.fs

// #r "nuget: Ply"
// #r "nuget: BCrypt.Net-Next"

module FsDemo.Demo2

open System
open System.Text
open System.Threading.Tasks
open FSharp.Control.Tasks.Builders

[<Struct>] type Effect<'env, 'out> = Effect of ('env -> 'out)

module Effect =
    /// Create value with no dependency requirements.
    let inline value (x: 'out): Effect<'env,'out> = Effect (fun _ -> x)
    /// Create value which uses depenendency.
    let inline apply (fn: 'env -> 'out): Effect<'env,'out> = Effect fn
    let map (fn: 'out1 -> 'out2) (Effect eff) = Effect (eff >> fn)
    let run (env: 'env) (Effect fn): 'out = fn env
    let inline bind (fn: 'a -> Effect<'env,'b>) effect =
        Effect (fun env ->
            let x = run env effect // compute result of the first effect
            run env (fn x) // run second effect, based on result of first one
        )

[<Struct>]
type EffectBuilder =
    member inline __.Return value = Effect.value value
    member inline __.Zero () = Effect.value (Unchecked.defaultof<_>)
    member inline __.ReturnFrom (effect: Effect<'env, 'out>) = effect
    member inline __.Bind(effect, fn) = Effect.bind fn effect
    
let effect = EffectBuilder()

[<Interface>]
type ILogger =
    abstract Info: string -> unit
    abstract Error: string -> unit
    
[<Interface>]
type ILog = abstract Logger: ILogger

module Log =
    let info fmt =
        let ap s = Effect.apply (fun (x: #ILog) -> x.Logger.Info s)
        Printf.kprintf ap fmt
    let error fmt = 
        let ap s = Effect.apply (fun (x: #ILog) -> x.Logger.Error s)
        Printf.kprintf ap fmt
    
[<Interface>]
type IDatabase =
    abstract Query: string * 'i -> 'o
    abstract Execute: string * 'i -> unit
    
[<Interface>]
type IDb = abstract Database: IDatabase

module Db =
    module Queries =
        let FetchUser = "SELECT * FROM users WHERE UserId = @userId"
        let UpdateUser = "UPDATE users SET Hash = @Hash, Salt = @Salt WHERE UserId = @userId"
    
    let fetchUser userId = Effect <| fun (env: #IDb) -> env.Database.Query(Queries.FetchUser, {| userId = userId |})
    let updateUser user =  Effect <| fun (env: #IDb) -> env.Database.Execute(Queries.UpdateUser, user)
    
[<Interface>]
type IRandom = abstract Random: Random

module Random =
        
    let bytes count = Effect <| fun (env: #IRandom) ->
        let array = Array.zeroCreate count
        env.Random.NextBytes array
        array
        
    let string count =
        bytes count |> Effect.map BitConverter.ToString


type User = { Id: int; Name: string; Hash: string; Salt: string }
type ChangePassReq = { UserId: int; OldPass: string; NewPass: string }
        
let bcrypt salt password = BCrypt.Net.BCrypt.HashPassword(password, salt)

(* --------- TEST APP --------- *)

module App =
    
    let changePass req = effect {
        let! user = Db.fetchUser req.UserId
        if user.Hash = bcrypt user.Salt req.OldPass then
            let! salt = Random.string 32
            do! Db.updateUser { user with Salt = salt; Hash = bcrypt salt req.NewPass }
            do! Log.info "Changed password for user %i" user.Id
            return Ok ()
        else 
            do! Log.error "Password change unauthorized: user %i" user.Id
            return Error "Old password is invalid"
    }
    
    [<Sealed>]
    type Env() =
        interface IRandom with member _.Random = failwith "not implemented"
        interface IDb with member _.Database = failwith "not implemented"
        interface ILog with member _.Logger = failwith "not implemented"
    
(* --------- RUN --------- *)
    
let run () =
    let env = App.Env ()
    let req = { UserId = 1; OldPass = "admin123"; NewPass = "admin234" }
    App.changePass req |> Effect.run env