yep

WerknemersInRooster.fs

module WerknemerInRooster

module Types =
    open System
    open Common.Validation

    type Werknemer = {
        WerknemerId : string
        WerknemerInternalId : Guid
        RoosterId : Guid
        Voornaam : string
        Achternaam : string
    }
    
    type WerknemerWerdToegevoegdAanRooster = {
        WerknemerId : string
        WerknemerInternalId : Guid
        RoosterId : Guid
        Voornaam : string
        Achternaam : string
    }

    type WerknemerWerdVerwijderdUitRooster = {
        RoosterId : Guid
        WerknemerInternalId : Guid
    }
    
    type Event = 
    | WerknemerWerdToegevoegdAanRooster of WerknemerWerdToegevoegdAanRooster
    | WerknemerWerdVerwijderdUitRooster of WerknemerWerdVerwijderdUitRooster
    
    [<CLIMutable>]
    type UnvalidatedVoegWerknemerToeForm = {
        WerknemerId : string
        WerknemerInternalId : string
        RoosterId : string
        Voornaam : string
        Achternaam : string
    }

    type ValidatedVoegWerknemerToeForm = {
        WerknemerId : string
        WerknemerInternalId : Guid
        RoosterId : Guid
        Voornaam : string
        Achternaam : string
    }
    
    type VoegWerknemerToeAanRoosterError =
    | Validation of ValidationError list
    | PersistenceError of exn list
    | AuthenticationError
    
    [<CLIMutable>]
    type UnvalidatedVerwijderWerknemerUitRoosterForm = {
        RoosterId : string
        WerknemerInternalId : string
    }

    type ValidatedVerwijderWerknemerUitRoosterForm = {
        RoosterId : Guid
        WerknemerInternalId : Guid
    }
    
    type VerwijderWerknemerUitRoosterError =
    | Validation of ValidationError list
    | PersistenceError of exn list
    | AuthenticationError

module UnvalidatedVoegWerknemerToeForm =
    open Types
    open Common.Validation

    let validate (unvalidated : UnvalidatedVoegWerknemerToeForm) : Result<ValidatedVoegWerknemerToeForm, ValidationError list> =
        let werknemerIdResult = notBlank "WerknemerId" unvalidated.WerknemerId
        let werknemerInternalIdResult = validateGuid "WerknemerInternalId" unvalidated.WerknemerInternalId
        let roosterIdResult = validateGuid "RoosterId" unvalidated.RoosterId
        let voornaamResult = notBlank "Voornaam" unvalidated.Voornaam
        let achternaamResult = notBlank "Achternaam" unvalidated.Achternaam

        match werknemerIdResult, werknemerInternalIdResult, roosterIdResult, voornaamResult, achternaamResult with
        | Ok werknemerId, Ok werknemerInternalIdResult, Ok roosterId, Ok voornaam, Ok achternaam ->
            Ok {
                WerknemerId = werknemerId
                WerknemerInternalId = werknemerInternalIdResult
                RoosterId = roosterId
                Voornaam = voornaam
                Achternaam = achternaam
            }
        | _ ->
            let err = function | Ok _ -> None | Error s -> Some s

            [err werknemerIdResult; err werknemerInternalIdResult; err roosterIdResult; err voornaamResult; err achternaamResult]
            |> List.choose id
            |> Error

module UnvalidatedVerwijderWerknemerUitRoosterForm =
    open Common.Validation
    open Types

    let validate (unvalidated : UnvalidatedVerwijderWerknemerUitRoosterForm) =
        let roosterIdResult = validateGuid "RoosterId" unvalidated.RoosterId
        let werknemerInternalIdResult = validateGuid "WerknemerInternalId" unvalidated.WerknemerInternalId

        match roosterIdResult, werknemerInternalIdResult with
        | Ok roosterId, Ok werknemerInternalId ->
            Ok {
                RoosterId = roosterId
                WerknemerInternalId = werknemerInternalId
            }
        | _ ->
            let err = function | Ok _ -> None | Error s -> Some s

            [err roosterIdResult; err werknemerInternalIdResult]
            |> List.choose id
            |> Error

module Aggregate =
    open System
    open Types

    let voegWerknemerToeAanRooster (werknemerId:string) (werknemerInternalId:Guid) (roosterId:Guid) (voornaam:string) (achternaam:string) =
        let werknemer : WerknemerWerdToegevoegdAanRooster = { 
            WerknemerId = werknemerId 
            WerknemerInternalId = werknemerInternalId 
            RoosterId = roosterId 
            Voornaam = voornaam 
            Achternaam = achternaam 
        }
        WerknemerWerdToegevoegdAanRooster werknemer

    let verwijderWerknemerUitRooster (roosterId:Guid) (werknemerInternalId:Guid) =
        WerknemerWerdVerwijderdUitRooster { RoosterId = roosterId; WerknemerInternalId = werknemerInternalId }

module Serialization =
    open Types
    open Common
    open Newtonsoft.Json

    let contract (event : Event) =
        let ns = "WerknemerInRooster"
        let version = 1
        let createContract = Contract.create ns version

        match event with
            | WerknemerWerdToegevoegdAanRooster _ -> "WerknemerWerdToegevoegdAanRooster"
            | WerknemerWerdVerwijderdUitRooster _ -> "WerknemerWerdVerwijderdUitRooster"
        |> createContract

    let serializePayload = function
        | WerknemerWerdToegevoegdAanRooster payload -> JsonConvert.SerializeObject payload
        | WerknemerWerdVerwijderdUitRooster payload -> JsonConvert.SerializeObject payload

module Persistence =
    open System
    open Types
    open Npgsql.FSharp
    open Infrastructure
    
    let toStmt event : Psql.Statement =
        match event with
        | WerknemerWerdToegevoegdAanRooster e ->
            let sql = "INSERT INTO werknemers (werknemerid, werknemerinternalid, roosterid, voornaam, achternaam)
                VALUES (@werknemerId, @werknemerInternalId, @roosterId, @voornaam, @achternaam)"
            let ps = [
                "werknemerId", SqlValue.String e.WerknemerId
                "werknemerInternalId", SqlValue.Uuid e.WerknemerInternalId
                "roosterId", SqlValue.Uuid e.RoosterId
                "voornaam", SqlValue.String e.Voornaam
                "achternaam", SqlValue.String e.Achternaam
            ]
            sql,ps
        | WerknemerWerdVerwijderdUitRooster e ->
            let sqls = [
                "DELETE FROM werknemers WHERE werknemerinternalid = @id"
                "UPDATE diensten SET huidigebezetting = (huidigebezetting - 1) 
                WHERE dienstid IN (SELECT dienstid FROM geplandediensten WHERE medewerkerid = @id)"
                "DELETE FROM geplandediensten WHERE medewerkerid = @id"
            ]
            let ps = [ "id", SqlValue.Uuid e.WerknemerInternalId ]
            String.concat ";" sqls, ps

    let save (now : unit -> DateTime) user conn events =
        let append = EventStore.append now Serialization.serializePayload Serialization.contract user conn
        let eventStmts = append events
        let stmts = List.map toStmt events
        
        [ stmts; eventStmts ]
        |> List.concat
        |> Psql.transactional conn

module UseCases =
    open System
    open Types
    open Common
    open Common.Types
    open Common.AsyncResult.Operators
    
    let private now () = DateTime.Now
    
    let private authenticateOr err msg =
        msg.Claims |> Helpers.getUsername |> Result.ofOption err |> Result.map (tuple msg.Payload) |> Async.retn
    
    // @todo twee keer zelfde werknemer toevoegen zal momenteel crashen
    // kunnen dit makkelijk idempotent maken
    let voegWerknemerToeAanRooster conn (msg : Message<UnvalidatedVoegWerknemerToeForm>) =
        let validate (form, username) =
            form
            |> UnvalidatedVoegWerknemerToeForm.validate
            |> Result.mapError VoegWerknemerToeAanRoosterError.Validation
            |> Result.map (tuple username)
            |> Async.retn

        let create ((username, form) : string * ValidatedVoegWerknemerToeForm) =
            Aggregate.voegWerknemerToeAanRooster
                form.WerknemerId
                form.WerknemerInternalId
                form.RoosterId
                form.Voornaam
                form.Achternaam
            |> List.retn
            |> tuple username
            |> AsyncResult.retn
        
        let save (username, events) =
            events
            |> Persistence.save now conn username
            |> AsyncResult.map (always events)
            |> AsyncResult.mapError VoegWerknemerToeAanRoosterError.PersistenceError
        
        let msg = AsyncResult.retn msg
                
        msg
        >>= authenticateOr VoegWerknemerToeAanRoosterError.AuthenticationError
        >>= validate
        >>= create
        >>= save
        
    let verwijderWerknerUitRooster conn (msg : Message<UnvalidatedVerwijderWerknemerUitRoosterForm>) =
        let validate (form, username) =
            form
            |> UnvalidatedVerwijderWerknemerUitRoosterForm.validate
            |> Result.mapError VerwijderWerknemerUitRoosterError.Validation
            |> Result.map (tuple username)
            |> Async.retn
        
        let verwijder ((username, form) : string * ValidatedVerwijderWerknemerUitRoosterForm) =
            (form.RoosterId, form.WerknemerInternalId)
            ||> Aggregate.verwijderWerknemerUitRooster
            |> List.retn
            |> tuple username
            |> AsyncResult.retn
        
        let save (username, events) =
            events
            |> Persistence.save now conn username
            |> AsyncResult.map (always events)
            |> AsyncResult.mapError VerwijderWerknemerUitRoosterError.PersistenceError
        
        let msg = AsyncResult.retn msg
        
        msg
        >>= authenticateOr VerwijderWerknemerUitRoosterError.AuthenticationError
        >>= validate
        >>= verwijder
        >>= save