Repository: atsapura/CardManagement Branch: master Commit: 412af96601d1 Files: 45 Total size: 161.2 KB Directory structure: gitextract_g_zz3ke9/ ├── .dockerignore ├── .gitignore ├── CardManagement/ │ ├── BalanceOperation.fs │ ├── CardActions.fs │ ├── CardDomain.fs │ ├── CardDomainCommandModels.fs │ ├── CardDomainQueryModels.fs │ ├── CardManagement.fsproj │ ├── CardProgramBuilder.fs │ └── CardWorkflow.fs ├── CardManagement.Api/ │ └── CardManagement.Api/ │ ├── CardManagement.Api.fsproj │ ├── Dockerfile │ ├── OptionConverter.fs │ ├── Program.fs │ ├── Properties/ │ │ └── launchSettings.json │ ├── appsettings.Development.json │ └── appsettings.json ├── CardManagement.Common/ │ ├── CardManagement.Common.fsproj │ ├── Common.fs │ ├── CommonTypes.fs │ ├── Country.fs │ ├── ErrorMessages.fs │ └── Errors.fs ├── CardManagement.Console/ │ ├── CardManagement.Console.fsproj │ ├── Program.fs │ ├── appsettings.Development.json │ └── appsettings.json ├── CardManagement.Data/ │ ├── CardDataPipeline.fs │ ├── CardDomainEntities.fs │ ├── CardManagement.Data.fsproj │ ├── CardMongoConfiguration.fs │ ├── CommandRepository.fs │ ├── DomainToEntityMapping.fs │ ├── EntityToDomainMapping.fs │ └── QueryRepository.fs ├── CardManagement.Infrastructure/ │ ├── AppConfiguration.fs │ ├── CardApi.fs │ ├── CardManagement.Infrastructure.fsproj │ ├── CardProgramInterpreter.fs │ └── Logging.fs ├── CardManagement.sln ├── README.md ├── SampleCalls.http ├── article/ │ └── Fighting.Complexity.md └── docker/ └── docker-compose.yml ================================================ FILE CONTENTS ================================================ ================================================ FILE: .dockerignore ================================================ .dockerignore .env .git .gitignore .vs .vscode */bin */obj **/.toolstarget ================================================ FILE: .gitignore ================================================ /.vs [Bb]in [Oo]bj [Dd]ebug [Rr]elease *.user *.suo /.vscode /.ionide ================================================ FILE: CardManagement/BalanceOperation.fs ================================================ namespace CardManagement [] module BalanceOperation = open CardDomain open System open CardManagement.Common let isDecrease change = match change with | Increase _ -> false | Decrease _ -> true let spentAtDate (date: DateTimeOffset) cardNumber operations = let date = date.Date let operationFilter { CardNumber = number; BalanceChange = change; Timestamp = timestamp } = isDecrease change && number = cardNumber && timestamp.Date = date let spendings = List.filter operationFilter operations List.sumBy (fun s -> -s.BalanceChange.ToDecimal()) spendings |> Money ================================================ FILE: CardManagement/CardActions.fs ================================================ namespace CardManagement (* This module contains business logic only. It doesn't know anything about data access layer, it doesn't deal with composition, the only thing we have here is functions, which represent business data transformations. Note that all the functions here are pure and total: they don't deal with any kind of external state, they have no side effects, and they can successfully process ANY kind of input - they don't throw exceptions. Since they deal with domain types (which earlier we designed in a way that invalid data can't be represented with them), we don't need to do input validation here. The only error we return in here is `OperationNotAllowedError`, which means that user provided valid data but wants to do something that is not allowed, e.g. pay with expired card. *) module CardActions = open System open CardDomain open CardManagement.Common.Errors open CardManagement.Common let private isExpired (currentDate: DateTimeOffset) (month: Month, year: Year) = (int year.Value, month.ToNumber() |> int) < (currentDate.Year, currentDate.Month) let private setDailyLimitNotAllowed = operationNotAllowed "Set daily limit" let private processPaymentNotAllowed = operationNotAllowed "Process payment" let private cardExpiredMessage (cardNumber: CardNumber) = sprintf "Card %s is expired" cardNumber.Value let private cardDeactivatedMessage (cardNumber: CardNumber) = sprintf "Card %s is deactivated" cardNumber.Value let isCardExpired (currentDate: DateTimeOffset) card = isExpired currentDate card.Expiration let deactivate card = match card.AccountDetails with | Deactivated -> card | Active _ -> { card with AccountDetails = Deactivated } let activate (cardAccountInfo: AccountInfo) card = match card.AccountDetails with | Active _ -> card | Deactivated -> { card with AccountDetails = Active cardAccountInfo } let setDailyLimit (currentDate: DateTimeOffset) limit card = if isCardExpired currentDate card then cardExpiredMessage card.CardNumber |> setDailyLimitNotAllowed else match card.AccountDetails with | Deactivated -> cardDeactivatedMessage card.CardNumber |> setDailyLimitNotAllowed | Active accInfo -> { card with AccountDetails = Active { accInfo with DailyLimit = limit } } |> Ok let processPayment (currentDate: DateTimeOffset) (spentToday: Money) card (paymentAmount: MoneyTransaction) = if isCardExpired currentDate card then cardExpiredMessage card.CardNumber |> processPaymentNotAllowed else match card.AccountDetails with | Deactivated -> cardDeactivatedMessage card.CardNumber |> processPaymentNotAllowed | Active accInfo -> if paymentAmount.Value > accInfo.Balance.Value then sprintf "Insufficent funds on card %s" card.CardNumber.Value |> processPaymentNotAllowed else match accInfo.DailyLimit with | Limit limit when limit < spentToday + paymentAmount -> sprintf "Daily limit is exceeded for card %s with daily limit %M. Today was spent %M" card.CardNumber.Value limit.Value spentToday.Value |> processPaymentNotAllowed (* We could use here the ultimate wild card case like this: | _ -> but it's dangerous because if a new case appears in `DailyLimit` type, we won't get a compile error here, which would remind us to process this new case in here. So this is a safe way to do the same thing. *) | Limit _ | Unlimited -> let newBalance = accInfo.Balance - paymentAmount let updatedCard = { card with AccountDetails = Active { accInfo with Balance = newBalance } } let balanceOperation = { Timestamp = currentDate CardNumber = card.CardNumber NewBalance = newBalance BalanceChange = Decrease paymentAmount } Ok (updatedCard, balanceOperation) let topUp (currentDate: DateTimeOffset) card (topUp : MoneyTransaction) = let topUpNotAllowed = operationNotAllowed "Top up" if isCardExpired currentDate card then cardExpiredMessage card.CardNumber |> topUpNotAllowed else match card.AccountDetails with | Deactivated -> cardDeactivatedMessage card.CardNumber |> topUpNotAllowed | Active accInfo -> let newBalance = accInfo.Balance + topUp let updatedCard = { card with AccountDetails = Active { accInfo with Balance = newBalance } } let balanceOperation = { Timestamp = currentDate NewBalance = newBalance CardNumber = card.CardNumber BalanceChange = Increase topUp } Ok (updatedCard, balanceOperation) ================================================ FILE: CardManagement/CardDomain.fs ================================================ namespace CardManagement (* This file contains our domain types. There are several important goals to pursue when you do domain modeling: - Tell AS MUCH as you can with your type: expected states, descriptive naming and so on. - Make invalid state unrepresentable using private constructors and built in validation. - Make illegal operations impossible: e.g. if deactivated credit card can't be used for payment, hide all the information, which is needed to complete an operation. *) module CardDomain = open System.Text.RegularExpressions open CardManagement.Common.Errors open CardManagement.Common open System let private cardNumberRegex = new Regex("^[0-9]{16}$", RegexOptions.Compiled) (* Technically card number is represented with a string. But it has certain validation rules which we don't want to be violated, so instead of throwing exception like one would do in C#, we create separate type, make it's constructor private and expose a factory method which returns `Result` with possible `ValidationError`. So whenever we have an instance of `CardNumber`, we can be certain, that the value inside is valid. *) type CardNumber = private CardNumber of string with member this.Value = match this with CardNumber s -> s static member create fieldName str = match str with | (null|"") -> validationError fieldName "card number can't be empty" | str -> if cardNumberRegex.IsMatch(str) then CardNumber str |> Ok else validationError fieldName "Card number must be a 16 digits string" (* Again, technically daily limit is represented with `decimal`. But `decimal` isn't quite what we need here. It can be negative, which is not a valid value for daily limit. It can also be a zero, and it may mean that there's no daily limit or it may mean that no purchase can be made at all. We could also use `Nullable`, but then we would be in danger of `NullReferenceException` or someone could along the way use construction `?? 0`. In any case this is much easier to read: *) [] type DailyLimit = private | Limit of Money | Unlimited with static member ofDecimal dec = if dec > 0m then Money dec |> Limit else Unlimited member this.ToDecimalOption() = match this with | Unlimited -> None | Limit limit -> Some limit.Value (* Since we made our constructor private, we can't pattern match it directly from outside, so we expose this Active Pattern to be able to see what's inside, but without a possibility of direct creation of this type. In a nutshell it's sort of `{ get; private set; }` for the whole type. *) let (|Limit|Unlimited|) limit = match limit with | Limit dec -> Limit dec | Unlimited -> Unlimited type UserId = System.Guid type AccountInfo = { HolderId: UserId Balance: Money DailyLimit: DailyLimit } with static member Default userId = { HolderId = userId Balance = Money 0m DailyLimit = Unlimited } (* This bit is important. As you can see, `AccountInfo` type is holding information about the money you have, which is clearly mandatory when you need to process a payment. Now, we don't want anyone to be able to process a payment with deactivated card, so we just don't provide this information when the card isn't active. Now this important business rule can't be violated by accident. *) type CardAccountInfo = | Active of AccountInfo | Deactivated (* We could use `DateTime` type to represent an expiration date. But `DateTime` contains way more information then we need. Which would rise a lot of questions: - What do we do with the time? - What about timezone? - What about day of month? Now it's clear that expiration is about just month and year. *) type Card = { CardNumber: CardNumber Name: LetterString HolderId: UserId Expiration: (Month * Year) AccountDetails: CardAccountInfo } type CardDetails = { Card: Card HolderAddress: Address HolderId: UserId HolderName: LetterString } type UserInfo = { Name: LetterString Id: UserId Address: Address } type User = { UserInfo : UserInfo Cards: Card list } [] type BalanceChange = | Increase of increase: MoneyTransaction | Decrease of decrease: MoneyTransaction with member this.ToDecimal() = match this with | Increase i -> i.Value | Decrease d -> -d.Value [] type BalanceOperation = { CardNumber: CardNumber Timestamp: DateTimeOffset BalanceChange: BalanceChange NewBalance: Money } ================================================ FILE: CardManagement/CardDomainCommandModels.fs ================================================ namespace CardManagement (* This module contains command models, validated commands and validation functions. In C# common pattern is to throw exception if input is invalid and pass it further if it's ok. Problem with that approach is if we forget to validate, the code will compile and a program either won't crash at all, or it will in some unexpected place. So we have to cover that with unit tests. Here however we use different types for validated entities. So even if we try to miss validation, the code won't even compile. *) module CardDomainCommandModels = open CardManagement.Common open CardDomain open CardManagement.Common.Errors open FsToolkit.ErrorHandling type ActivateCommand = { CardNumber: CardNumber } type DeactivateCommand = { CardNumber: CardNumber } type SetDailyLimitCommand = { CardNumber: CardNumber DailyLimit: DailyLimit } type ProcessPaymentCommand = { CardNumber: CardNumber PaymentAmount: MoneyTransaction } type TopUpCommand = { CardNumber: CardNumber TopUpAmount: MoneyTransaction } [] type ActivateCardCommandModel = { CardNumber: string } [] type DeactivateCardCommandModel = { CardNumber: string } [] type SetDailyLimitCardCommandModel = { CardNumber: string Limit: decimal } [] type ProcessPaymentCommandModel = { CardNumber: string PaymentAmount: decimal } [] type TopUpCommandModel = { CardNumber: string TopUpAmount: decimal } [] type CreateAddressCommandModel = { Country: string City: string PostalCode: string AddressLine1: string AddressLine2: string } [] type CreateUserCommandModel = { Name: string Address: CreateAddressCommandModel } [] type CreateCardCommandModel = { CardNumber : string Name: string ExpirationMonth: uint16 ExpirationYear: uint16 UserId: UserId } (* This is a brief API description made with just type aliases. As you can see, every public function here returns a `Result` with possible `ValidationError`. No other error can occur in here. *) type ValidateActivateCardCommand = ActivateCardCommandModel -> ValidationResult type ValidateDeactivateCardCommand = DeactivateCardCommandModel -> ValidationResult type ValidateSetDailyLimitCommand = SetDailyLimitCardCommandModel -> ValidationResult type ValidateProcessPaymentCommand = ProcessPaymentCommandModel -> ValidationResult type ValidateTopUpCommand = TopUpCommandModel -> ValidationResult type ValidateCreateAddressCommand = CreateAddressCommandModel -> ValidationResult
type ValidateCreateUserCommand = CreateUserCommandModel -> ValidationResult type ValidateCreateCardCommand = CreateCardCommandModel -> ValidationResult let private validateCardNumber = CardNumber.create "cardNumber" let validateActivateCardCommand : ValidateActivateCardCommand = fun cmd -> result { let! number = cmd.CardNumber |> validateCardNumber return { ActivateCommand.CardNumber = number } } let validateDeactivateCardCommand : ValidateDeactivateCardCommand = fun cmd -> result { let! number = cmd.CardNumber |> validateCardNumber return { DeactivateCommand.CardNumber = number } } let validateSetDailyLimitCommand : ValidateSetDailyLimitCommand = fun cmd -> result { let! number = cmd.CardNumber |> validateCardNumber let limit = DailyLimit.ofDecimal cmd.Limit return { CardNumber = number DailyLimit = limit } } let validateProcessPaymentCommand : ValidateProcessPaymentCommand = fun cmd -> result { let! number = cmd.CardNumber |> validateCardNumber let! amount = cmd.PaymentAmount |> MoneyTransaction.create return { ProcessPaymentCommand.CardNumber = number PaymentAmount = amount } } let validateTopUpCommand : ValidateTopUpCommand = fun cmd -> result { let! number = cmd.CardNumber |> validateCardNumber let! amount = cmd.TopUpAmount |> MoneyTransaction.create return { TopUpCommand.CardNumber = number TopUpAmount = amount } } let validateCreateAddressCommand : ValidateCreateAddressCommand = fun cmd -> result { let! country = parseCountry cmd.Country let! city = LetterString.create "city" cmd.City let! postalCode = PostalCode.create "postalCode" cmd.PostalCode return { Address.Country = country City = city PostalCode = postalCode AddressLine1 = cmd.AddressLine1 AddressLine2 = cmd.AddressLine2} } let validateCreateUserCommand userId : ValidateCreateUserCommand = fun cmd -> result { let! name = LetterString.create "name" cmd.Name let! address = validateCreateAddressCommand cmd.Address return { UserInfo.Id = userId Name = name Address = address } } let validateCreateCardCommand : ValidateCreateCardCommand = fun cmd -> result { let! name = LetterString.create "name" cmd.Name let! number = CardNumber.create "cardNumber" cmd.CardNumber let! month = Month.create "expirationMonth" cmd.ExpirationMonth let! year = Year.create "expirationYear" cmd.ExpirationYear return { Card.CardNumber = number Name = name HolderId = cmd.UserId Expiration = month,year AccountDetails = AccountInfo.Default cmd.UserId |> Active } } ================================================ FILE: CardManagement/CardDomainQueryModels.fs ================================================ namespace CardManagement (* This module contains mappings of our domain types to something that user/client will see. Since JSON and a lot of popular languages now do not support Discriminated Unions, which we heavily use in our domain, we have to convert our domain types to something represented by common types. *) module CardDomainQueryModels = open System open CardDomain open CardManagement.Common type AddressModel = { Country: string City: string PostalCode: string AddressLine1: string AddressLine2: string } type BasicCardInfoModel = { CardNumber: string Name: string ExpirationMonth: uint16 ExpirationYear: uint16 } type CardInfoModel = { BasicInfo: BasicCardInfoModel Balance: decimal option DailyLimit: decimal option IsActive: bool } type CardDetailsModel = { CardInfo: CardInfoModel HolderName: string HolderAddress: AddressModel } type UserModel = { Id: Guid Name: string Address: AddressModel Cards: CardInfoModel list } let toBasicInfoToModel (basicCard: Card) = { CardNumber = basicCard.CardNumber.Value Name = basicCard.Name.Value ExpirationMonth = (fst basicCard.Expiration).ToNumber() ExpirationYear = (snd basicCard.Expiration).Value } let toCardInfoModel card = let (balance, dailyLimit, isActive) = match card.AccountDetails with | Active accInfo -> (accInfo.Balance.Value |> Some, accInfo.DailyLimit.ToDecimalOption(), true) | Deactivated -> (None, None, false) { BasicInfo = card |> toBasicInfoToModel Balance = balance DailyLimit = dailyLimit IsActive = isActive } let toAddressModel (address: Address) = { Country = address.Country.ToString() City = address.City.Value PostalCode = address.PostalCode.Value AddressLine1 = address.AddressLine1 AddressLine2 = address.AddressLine2 } let toCardDetailsModel (cardDetails: CardDetails) = { CardInfo = cardDetails.Card |> toCardInfoModel HolderName = cardDetails.HolderName.Value HolderAddress = cardDetails.HolderAddress |> toAddressModel } let toUserModel (user: User) = { Id = user.UserInfo.Id Name = user.UserInfo.Name.Value Address = user.UserInfo.Address |> toAddressModel Cards = user.Cards |> List.map toCardInfoModel } ================================================ FILE: CardManagement/CardManagement.fsproj ================================================  netstandard2.0 true ================================================ FILE: CardManagement/CardProgramBuilder.fs ================================================ namespace CardManagement module CardProgramBuilder = open CardDomain open System open CardManagement.Common open Errors (* Ok, this requires some explanation. So we've created a lot of functions for validation, logic and model mapping. All of those functions are pure, so combining them in here is totally fine. But we have to interact with DB and functions for that are in another layer, we don't have access to them. However we have to make business logic decisions based on output of those functions, so we have to emulate or inject them or whatever. In OOP they use DI frameworks for that, but since the ultimate goal is to move as many errors in compile time as possible, using classic IoC container would be a step in the opposite direction. How do we solve this? At first I chose the most obvious way and just passed all the dependencies in the functions. I kept this code in `obsolete-dependency-managing` branch, see `CardPipeline.fs` file. Another option (this one) is to use Interpreter pattern. The idea is that we divide our composition code in 2 parts: execution tree and interpreter for that tree. Execution tree is a set of sequentual instructions, like this: - validate input card number, if it's valid - get me a card by that number. If there's one - activate it. - save result. - map it to model and return. Now, this tree doesn't know what database we use, what library we use to call it, it doesn't even know whether we use sync or async calls to do that. All it knows is a name of operation, input parameter type and return type. Basically a signature, but without any side effect information, e.g. `Card` instead of `Task` or `Async`. But since we are building a tree structure, instead of using interfaces or plain function signatures, we use union type with a tuple inside every case. We use 1 union for 1 bounded context (in our case the whole app is 1 context). This union represents all the possible dependencies we use in this bounded context. Every case replresent a placeholder for a dependency. First element of a tuple inside the case is an input parameter of dependency. A second tuple is a function, which receives an output parameter of that dependency and returns the rest of our execution tree branch. *) type Program<'a> = | GetCard of CardNumber * (Card option -> Program<'a>) | GetCardWithAccountInfo of CardNumber * ((Card*AccountInfo) option -> Program<'a>) | CreateCard of (Card*AccountInfo) * (Result -> Program<'a>) | ReplaceCard of Card * (Result -> Program<'a>) | GetUser of UserId * (User option -> Program<'a>) | CreateUser of UserInfo * (Result -> Program<'a>) | GetBalanceOperations of (CardNumber * DateTimeOffset * DateTimeOffset) * (BalanceOperation list -> Program<'a>) | SaveBalanceOperation of BalanceOperation * (Result -> Program<'a>) | Stop of 'a // This bind function allows you to pass a continuation for current node of your expression tree // the code is basically a boiler plate, as you can see. let rec bind f instruction = match instruction with | GetCard (x, next) -> GetCard (x, (next >> bind f)) | GetCardWithAccountInfo (x, next) -> GetCardWithAccountInfo (x, (next >> bind f)) | CreateCard (x, next) -> CreateCard (x, (next >> bind f)) | ReplaceCard (x, next) -> ReplaceCard (x, (next >> bind f)) | GetUser (x, next) -> GetUser (x,(next >> bind f)) | CreateUser (x, next) -> CreateUser (x,(next >> bind f)) | GetBalanceOperations (x, next) -> GetBalanceOperations (x,(next >> bind f)) | SaveBalanceOperation (x, next) -> SaveBalanceOperation (x,(next >> bind f)) | Stop x -> f x // this is a set of basic functions. Use them in your expression tree builder to represent dependency call let stop x = Stop x let getCardByNumber number = GetCard (number, stop) let getCardWithAccountInfo number = GetCardWithAccountInfo (number, stop) let createNewCard (card, acc) = CreateCard ((card, acc), stop) let replaceCard card = ReplaceCard (card, stop) let getUserById id = GetUser (id, stop) let createNewUser user = CreateUser (user, stop) let getBalanceOperations (number, fromDate, toDate) = GetBalanceOperations ((number, fromDate, toDate), stop) let saveBalanceOperation op = SaveBalanceOperation (op, stop) // These are builders for computation expressions. Using CEs will make building execution trees very easy type SimpleProgramBuilder() = member __.Bind (x, f) = bind f x member __.Return x = Stop x member __.Zero () = Stop () member __.ReturnFrom x = x type ProgramBuilder() = member __.Bind (x, f) = bind f x member this.Bind (x, f) = match x with | Ok x -> this.ReturnFrom (f x) | Error e -> this.Return (Error e) member this.Bind((x: Program>), f) = let f x = match x with | Ok x -> this.ReturnFrom (f x) | Error e -> this.Return (Error e ) this.Bind(x, f) member __.Return x = Stop x member __.Zero () = Stop () member __.ReturnFrom x = x let program = ProgramBuilder() let simpleProgram = SimpleProgramBuilder() // This is example of using a computation expression `program` from above let expectDataRelatedErrorProgram (prog: Program>) = program { let! result = prog //here we retrieve return value from our program `prog`. Like async/await in C# return expectDataRelatedError result } ================================================ FILE: CardManagement/CardWorkflow.fs ================================================ namespace CardManagement (* Finally this is our composition of domain functions. In here we build those execution trees. If you want to see, how we inject dependencies in here, go to `CardManagement.Infrastructure.CardProgramInterpreter`. *) module CardWorkflow = open CardDomain open System open CardDomainCommandModels open CardManagement.Common open CardDomainQueryModels open Errors open CardProgramBuilder let private noneToError (a: 'a option) id = let error = EntityNotFound (sprintf "%sEntity" typeof<'a>.Name, id) Result.ofOption error a let private tryGetCard cardNumber = program { let! card = getCardByNumber cardNumber let! card = noneToError card cardNumber.Value |> expectDataRelatedError return Ok card } let processPayment (currentDate: DateTimeOffset, payment) = program { (* You can see these `expectValidationError` and `expectDataRelatedErrors` functions here. What they do is map different errors into `Error` type, since every execution branch must return the same type, in this case `Result<'a, Error>`. They also help you quickly understand what's going on in every line of code: validation, logic or calling external storage. *) let! cmd = validateProcessPaymentCommand payment |> expectValidationError let! card = tryGetCard cmd.CardNumber let today = currentDate.Date |> DateTimeOffset let tomorrow = currentDate.Date.AddDays 1. |> DateTimeOffset let! operations = getBalanceOperations (cmd.CardNumber, today, tomorrow) let spentToday = BalanceOperation.spentAtDate currentDate cmd.CardNumber operations let! (card, op) = CardActions.processPayment currentDate spentToday card cmd.PaymentAmount |> expectOperationNotAllowedError do! saveBalanceOperation op |> expectDataRelatedErrorProgram do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let setDailyLimit (currentDate: DateTimeOffset, setDailyLimitCommand) = program { let! cmd = validateSetDailyLimitCommand setDailyLimitCommand |> expectValidationError let! card = tryGetCard cmd.CardNumber let! card = CardActions.setDailyLimit currentDate cmd.DailyLimit card |> expectOperationNotAllowedError do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let topUp (currentDate: DateTimeOffset, topUpCmd) = program { let! cmd = validateTopUpCommand topUpCmd |> expectValidationError let! card = tryGetCard cmd.CardNumber let! (card, op) = CardActions.topUp currentDate card cmd.TopUpAmount |> expectOperationNotAllowedError do! saveBalanceOperation op |> expectDataRelatedErrorProgram do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let activateCard activateCmd = program { let! cmd = validateActivateCardCommand activateCmd |> expectValidationError let! result = getCardWithAccountInfo cmd.CardNumber let! (card, accInfo) = noneToError result cmd.CardNumber.Value |> expectDataRelatedError let card = CardActions.activate accInfo card do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let deactivateCard deactivateCmd = program { let! cmd = validateDeactivateCardCommand deactivateCmd |> expectValidationError let! card = tryGetCard cmd.CardNumber let card = CardActions.deactivate card do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let createUser (userId, createUserCommand) = program { let! userInfo = validateCreateUserCommand userId createUserCommand |> expectValidationError do! createNewUser userInfo |> expectDataRelatedErrorProgram return { UserInfo = userInfo Cards = [] } |> toUserModel |> Ok } let createCard cardCommand = program { let! card = validateCreateCardCommand cardCommand |> expectValidationError let accountInfo = AccountInfo.Default cardCommand.UserId do! createNewCard (card, accountInfo) |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } let getCard cardNumber = program { let! cardNumber = CardNumber.create "cardNumber" cardNumber |> expectValidationError let! card = getCardByNumber cardNumber return card |> Option.map toCardInfoModel |> Ok } let getUser userId = simpleProgram { let! maybeUser = getUserById userId return maybeUser |> Option.map toUserModel } ================================================ FILE: CardManagement.Api/CardManagement.Api/CardManagement.Api.fsproj ================================================  netcoreapp2.2 InProcess Linux c149e81d-fb35-4886-9174-bf495870ef54 true ================================================ FILE: CardManagement.Api/CardManagement.Api/Dockerfile ================================================ #Depending on the operating system of the host machines(s) that will build or run the containers, the image specified in the FROM statement may need to be changed. #For more information, please see https://aka.ms/containercompat FROM microsoft/dotnet:2.2-aspnetcore-runtime-nanoserver-1803 AS base WORKDIR /app EXPOSE 80 EXPOSE 443 FROM microsoft/dotnet:2.2-sdk-nanoserver-1803 AS build WORKDIR /src COPY ["CardManagement.Api/CardManagement.Api/CardManagement.Api.fsproj", "CardManagement.Api/CardManagement.Api/"] RUN dotnet restore "CardManagement.Api/CardManagement.Api/CardManagement.Api.fsproj" COPY . . WORKDIR "/src/CardManagement.Api/CardManagement.Api" RUN dotnet build "CardManagement.Api.fsproj" -c Release -o /app FROM build AS publish RUN dotnet publish "CardManagement.Api.fsproj" -c Release -o /app FROM base AS final WORKDIR /app COPY --from=publish /app . ENTRYPOINT ["dotnet", "CardManagement.Api.dll"] ================================================ FILE: CardManagement.Api/CardManagement.Api/OptionConverter.fs ================================================ namespace CardManagement.Api open Newtonsoft.Json open Microsoft.FSharp.Reflection open System open System.Collections.Concurrent [] module CustomConverters = let private unionCaseCache = ConcurrentDictionary() let getUnionCasesFromCache typ = match unionCaseCache.TryGetValue typ with | (true, cases) -> cases | _ -> let cases = FSharpType.GetUnionCases typ unionCaseCache.TryAdd(typ, cases) |> ignore cases type OptionConverter() = inherit JsonConverter() override x.CanConvert(typ) = typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> override x.WriteJson(writer, value, serializer) = let value = if isNull value then null else let _,fields = FSharpValue.GetUnionFields(value, value.GetType()) fields.[0] serializer.Serialize(writer, value) override x.ReadJson(reader, typ, existingValue, serializer) = let innerType = let innerType = typ.GetGenericArguments().[0] if innerType.IsValueType then typedefof>.MakeGenericType([|innerType|]) else innerType let cases = getUnionCasesFromCache typ if reader.TokenType = JsonToken.Null then FSharpValue.MakeUnion(cases.[0], Array.empty) else let value = serializer.Deserialize(reader, innerType) if isNull value then FSharpValue.MakeUnion(cases.[0], Array.empty) else FSharpValue.MakeUnion(cases.[1], [|value|]) ================================================ FILE: CardManagement.Api/CardManagement.Api/Program.fs ================================================ namespace CardManagement.Api open System open System.Collections.Generic open System.IO open System.Linq open System.Threading.Tasks open Microsoft.AspNetCore open Microsoft.AspNetCore.Hosting open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open Microsoft.AspNetCore.Builder open Microsoft.Extensions.DependencyInjection open Giraffe open CardManagement.Infrastructure open CardManagement open Common open Errors open ErrorMessages open Serilog module Program = open FSharp.Control.Tasks.V2 open CardManagement.CardDomainCommandModels open Giraffe.Serialization open Newtonsoft.Json open Newtonsoft.Json.Serialization type [] ErrorModel = { Error: string } let toErrorModel str = { Error = str } let notFound f = json { Error = "Not found."} f let errorHandler (ex: Exception) (logger: Microsoft.Extensions.Logging.ILogger) = match ex with | :? Newtonsoft.Json.JsonReaderException -> clearResponse >=> RequestErrors.BAD_REQUEST ex.Message | _ -> logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") ex.GetType().FullName |> printf "%s" clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message let errorToResponse e = let message = errorMessage e |> toErrorModel |> json match e with | Bug exn -> Log.Error(exn.ToString()) let err = toErrorModel "Oops. Something went wrong" |> json ServerErrors.internalError err | OperationNotAllowed _ | ValidationError _ -> RequestErrors.unprocessableEntity message | DataError e -> match e with | EntityNotFound _ -> RequestErrors.notFound message | _ -> RequestErrors.unprocessableEntity message let resultToHttpResponseAsync asyncWorkflow : HttpHandler = fun next ctx -> task { let! result = asyncWorkflow |> Async.StartAsTask let responseFn = match result with | Ok ok -> json ok |> Successful.ok | Error e -> errorToResponse e return! responseFn next ctx } let optionToHttpResponseAsync asyncWorkflow : HttpHandler = fun next ctx -> task { let! result = asyncWorkflow |> Async.StartAsTask let responseFn = match result with | Ok (Some ok) -> json ok |> Successful.ok | Ok None -> RequestErrors.notFound notFound | Error e -> errorToResponse e return! responseFn next ctx } let bindJsonForRoute<'a> r f = routeCi r >=> bindJson<'a> f let webApp = choose [ GET >=> choose [ routeCif "/users/%O" (fun userId -> CardApi.getUser userId |> optionToHttpResponseAsync) routeCif "/cards/%s" (fun cardNumber -> CardApi.getCard cardNumber |> optionToHttpResponseAsync) ] PATCH >=> choose [ bindJsonForRoute "/cards/deactivate" (fun cmd -> CardApi.deactivateCard cmd |> resultToHttpResponseAsync) bindJsonForRoute "/cards/activate" (fun cmd -> CardApi.activateCard cmd |> resultToHttpResponseAsync) bindJsonForRoute "/cards/setDailyLimit" (fun cmd -> CardApi.setDailyLimit (DateTimeOffset.UtcNow,cmd) |> resultToHttpResponseAsync) bindJsonForRoute "/cards/processPayment" (fun cmd -> CardApi.processPayment (DateTimeOffset.UtcNow,cmd) |> resultToHttpResponseAsync) bindJsonForRoute "/cards/topUp" (fun cmd -> CardApi.topUp (DateTimeOffset.UtcNow,cmd) |> resultToHttpResponseAsync) ] POST >=> choose [ bindJsonForRoute "/users" (fun cmd -> CardApi.createUser (Guid.NewGuid(),cmd) |> resultToHttpResponseAsync) bindJsonForRoute "/cards" (fun cmd -> CardApi.createCard cmd |> resultToHttpResponseAsync) ] RequestErrors.notFound notFound ] let configureApp (app : IApplicationBuilder) = // Add Giraffe to the ASP.NET Core pipeline app.UseGiraffeErrorHandler(errorHandler) .UseGiraffe webApp let configureServices (services : IServiceCollection) = // Add Giraffe dependencies services.AddGiraffe() |> ignore let customSettings = JsonSerializerSettings() customSettings.Converters.Add(OptionConverter()) let contractResolver = CamelCasePropertyNamesContractResolver() customSettings.ContractResolver <- contractResolver services.AddSingleton(NewtonsoftJsonSerializer(customSettings)) |> ignore [] let main args = AppConfiguration.configureLog() WebHostBuilder() .UseKestrel() .Configure(Action configureApp) .ConfigureServices(configureServices) .Build() .Run() 0 ================================================ FILE: CardManagement.Api/CardManagement.Api/Properties/launchSettings.json ================================================ { "iisSettings": { "windowsAuthentication": false, "anonymousAuthentication": true, "iisExpress": { "applicationUrl": "http://localhost:4364", "sslPort": 44318 } }, "profiles": { "IIS Express": { "commandName": "IISExpress", "launchBrowser": true, "environmentVariables": { "ASPNETCORE_ENVIRONMENT": "Development" } }, "CardManagement.Api": { "commandName": "Project", "launchBrowser": true, "environmentVariables": { "ASPNETCORE_ENVIRONMENT": "Development" }, "applicationUrl": "https://localhost:5001;http://localhost:5000" }, "Docker": { "commandName": "Docker", "launchBrowser": true, "launchUrl": "{Scheme}://{ServiceHost}:{ServicePort}" } } } ================================================ FILE: CardManagement.Api/CardManagement.Api/appsettings.Development.json ================================================ { "Logging": { "LogLevel": { "Default": "Debug", "System": "Information", "Microsoft": "Information" } } } ================================================ FILE: CardManagement.Api/CardManagement.Api/appsettings.json ================================================ { "MongoDB": { "Database": "CardDb", "Host": "localhost", "Port": 27017, "User": "root", "Password": "example" }, "Logging": { "LogLevel": { "Default": "Warning" } }, "AllowedHosts": "*" } ================================================ FILE: CardManagement.Common/CardManagement.Common.fsproj ================================================  netstandard2.0 true ================================================ FILE: CardManagement.Common/Common.fs ================================================ namespace CardManagement.Common [] module Common = let inline (|HasLength|) x = fun () -> (^a: (member Length: int) x) let inline (|HasCount|) x = fun () -> (^a: (member Count: int) x) let inline length (HasLength f) = f() let inline isNullOrEmpty arg = if arg = null || (length arg) = 0 then true else false let bindAsync f a = async { let! a = a return! f a } ================================================ FILE: CardManagement.Common/CommonTypes.fs ================================================ namespace CardManagement.Common [] module CommonTypes = open System.Text.RegularExpressions open CardManagement.Common.Errors let cardNumberRegex = new Regex("^[0-9]{16}$", RegexOptions.Compiled) let lettersRegex = new Regex("^[\w]+[\w ]+[\w]+$", RegexOptions.Compiled) let postalCodeRegex = new Regex("^[0-9]{5,6}$", RegexOptions.Compiled) type Month = | January | February | March | April | May | June | July | August | September | October | November | December with member this.ToNumber() = match this with | January -> 1us | February -> 2us | March -> 3us | April -> 4us | May -> 5us | June -> 6us | July -> 7us | August -> 8us | September -> 9us | October -> 10us | November -> 11us | December -> 12us static member create field n = match n with | 1us -> January |> Ok | 2us -> February |> Ok | 3us -> March |> Ok | 4us -> April |> Ok | 5us -> May |> Ok | 6us -> June |> Ok | 7us -> July |> Ok | 8us -> August |> Ok | 9us -> September |> Ok | 10us -> October |> Ok | 11us -> November |> Ok | 12us -> December |> Ok | _ -> validationError field "Number must be from 1 to 12" [] type Year = private Year of uint16 with member this.Value = match this with Year year -> year static member create field year = if year >= 2019us && year <= 2050us then Year year |> Ok else validationError field "Year must be between 2019 and 2050" type LetterString = private LetterString of string with member this.Value = match this with LetterString s -> s static member create field str = match str with | (""|null) -> validationError field "string must contain letters" | str -> if lettersRegex.IsMatch(str) then LetterString str |> Ok else validationError field "string must contain only letters" [] type MoneyTransaction = private MoneyTransaction of decimal with member this.Value = let (MoneyTransaction v) = this in v static member create amount = if amount > 0M then MoneyTransaction amount |> Ok else validationError "transaction" "Transaction amount must be positive" [] type Money = Money of decimal with member this.Value = match this with Money money -> money static member (+) (Money left, Money right) = left + right |> Money static member (-) (Money left, Money right) = left - right |> Money static member (+) (Money money, MoneyTransaction tran) = money + tran |> Money static member (-) (Money money, MoneyTransaction tran) = money - tran |> Money type PostalCode = private PostalCode of string with member this.Value = match this with PostalCode code -> code static member create field str = match str with | (""|null) -> validationError field "Postal code can't be empty" | str -> if postalCodeRegex.IsMatch(str) |> not then validationError field "postal code must contain 5 or 6 digits and nothing else" else PostalCode str |> Ok type Address = { Country: Country City: LetterString PostalCode: PostalCode AddressLine1: string AddressLine2: string } type nil<'a when 'a: struct and 'a: (new: unit-> 'a) and 'a:> System.ValueType> = System.Nullable<'a> ================================================ FILE: CardManagement.Common/Country.fs ================================================ namespace CardManagement.Common [] module CountryModule = open Microsoft.FSharp.Reflection open Errors type Country = | Afghanistan | Albania | Algeria | Andorra | Angola | ``Antigua and Barbuda`` | Argentina | Armenia | Australia | Austria | Azerbaijan | ``The Bahamas`` | Bahrain | Bangladesh | Barbados | Belarus | Belgium | Belize | Benin | Bhutan | Bolivia | ``Bosnia and Herzegovina`` | Botswana | Brazil | Brunei | Bulgaria | ``Burkina Faso`` | Burundi | ``Cabo Verde`` | Cambodia | Cameroon | Canada | ``Central African Republic`` | Chad | Chile | China | Colombia | Comoros | ``Congo, Democratic Republic of the`` | ``Congo, Republic of the`` | ``Costa Rica`` | ``Côte d’Ivoire`` | Croatia | Cuba | Cyprus | ``Czech Republic`` | Denmark | Djibouti | Dominica | ``Dominican Republic`` | ``East Timor (Timor-Leste)`` | Ecuador | Egypt | ``El Salvador`` | ``Equatorial Guinea`` | Eritrea | Estonia | Ethiopia | Fiji | Finland | France | Gabon | ``The Gambia`` | Georgia | Germany | Ghana | Greece | Grenada | Guatemala | Guinea | ``Guinea-Bissau`` | Guyana | Haiti | Honduras | Hungary | Iceland | India | Indonesia | Iran | Iraq | Ireland | Israel | Italy | Jamaica | Japan | Jordan | Kazakhstan | Kenya | Kiribati | ``Korea, North`` | ``Korea, South`` | Kosovo | Kuwait | Kyrgyzstan | Laos | Latvia | Lebanon | Lesotho | Liberia | Libya | Liechtenstein | Lithuania | Luxembourg | Macedonia | Madagascar | Malawi | Malaysia | Maldives | Mali | Malta | ``Marshall Islands`` | Mauritania | Mauritius | Mexico | ``Micronesia, Federated States of`` | Moldova | Monaco | Mongolia | Montenegro | Morocco | Mozambique | ``Myanmar (Burma)`` | Namibia | Nauru | Nepal | Netherlands | ``New Zealand`` | Nicaragua | Niger | Nigeria | Norway | Oman | Pakistan | Palau | Panama | ``Papua New Guinea`` | Paraguay | Peru | Philippines | Poland | Portugal | Qatar | Romania | Russia | Rwanda | ``Saint Kitts and Nevis`` | ``Saint Lucia`` | ``Saint Vincent and the Grenadines`` | Samoa | ``San Marino`` | ``Sao Tome and Principe`` | ``Saudi Arabia`` | Senegal | Serbia | Seychelles | ``Sierra Leone`` | Singapore | Slovakia | Slovenia | ``Solomon Islands`` | Somalia | ``South Africa`` | Spain | ``Sri Lanka`` | Sudan | ``Sudan, South`` | Suriname | Swaziland | Sweden | Switzerland | Syria | Taiwan | Tajikistan | Tanzania | Thailand | Togo | Tonga | ``Trinidad and Tobago`` | Tunisia | Turkey | Turkmenistan | Tuvalu | Uganda | Ukraine | ``United Arab Emirates`` | ``United Kingdom`` | ``United States`` | Uruguay | Uzbekistan | Vanuatu | ``Vatican City`` | Venezuela | Vietnam | Yemen | Zambia | Zimbabwe let (=~) str1 str2 = System.String.Equals(str1, str2, System.StringComparison.InvariantCultureIgnoreCase) let tryParseEmptyDUCase<'DU> str = if FSharpType.IsUnion typeof<'DU> |> not then None else match str with | null | "" -> None | str -> FSharpType.GetUnionCases typeof<'DU> |> Array.tryFind (fun c -> c.Name =~ str && (c.GetFields() |> Array.isEmpty)) |> Option.map (fun case -> FSharpValue.MakeUnion(case, [||]) :?> 'DU) let parseCountry country = match tryParseEmptyDUCase country with | Some country -> Ok country | None -> Error { FieldPath = "country"; Message = sprintf "Country %s is unknown" country} ================================================ FILE: CardManagement.Common/ErrorMessages.fs ================================================ namespace CardManagement.Common module ErrorMessages = open Errors let private entityDescription = sprintf "[%s] entity with id [%s]" let dataRelatedErrorMessage = function | EntityAlreadyExists (name, id) -> entityDescription name id |> sprintf "%s already exists." | EntityNotFound (name, id) -> entityDescription name id |> sprintf "%s was not found." | EntityIsInUse (name, id) -> entityDescription name id |> sprintf "%s is in use." | UpdateError (name, id, message) -> message |> (entityDescription name id |> sprintf "%s failed to update. Details:\n%s") let validationMessage { FieldPath = path; Message = message } = sprintf "Field [%s] is invalid. Message: %s" path message let operationNotAllowedMessage { Operation = op; Reason = reason } = sprintf "Operation [%s] is not allowed. Reason: %s" op reason let errorMessage error = match error with | ValidationError v -> validationMessage v | OperationNotAllowed o -> operationNotAllowedMessage o | DataError d -> dataRelatedErrorMessage d | Bug b -> sprintf "Oops, something went wrong.\n%A" b ================================================ FILE: CardManagement.Common/Errors.fs ================================================ namespace CardManagement.Common (* This module is about error handling. One of the problems with exceptions is they don't appear on function/method signature, so we don't know what to expect when calling particular method unless we read the code/docs. So one of the goals here is to make function signatures as descriptive as possible. That's why we introduce here different types of errors: - ValidationError: for functions that do only validation and nothing else. - OperationNotAllowedError: for business logic functions. Sometimes user provides valid data, but he wants to do something that can't be done, e.g. paying with credit card with no money on it. - DataRelatedError: for functions that communicate with data storages and 3rd party APIs. Some things can only be checked when you have enough data, you can't validate them just from your code. - Panic: for something unexpected. This means that something is broken, so it's most likely a bug. - Error: finally this is a type to gather all possible errors. ------------------------------------------------------------------------------------------------------- Having different types of errors and exposing them in function signatures gives us a lot of information about functions purpose: e.g. when function may return you `DataRelatedError`, you know it's about data access layer and nothing else. Same thing goes for `OperationNonAllowedError`: this function operates with valid input and checks only for business rules violations. And finally, if function returns just `Error`, it must be a composition of the whole pipeline: some validation, then probably business rules checking, then some calls to data base or something and so on. *) module Errors = open System type ValidationError = { FieldPath: string Message: string } type OperationNotAllowedError = { Operation: string Reason: string } type DataRelatedError = | EntityAlreadyExists of entityName: string * id: string | EntityNotFound of entityName: string * id: string | EntityIsInUse of entityName: string * id: string | UpdateError of entityName:string * id: string * message:string type Error = | ValidationError of ValidationError | OperationNotAllowed of OperationNotAllowedError | DataError of DataRelatedError | Bug of exn let validationError fieldPath message = { FieldPath = fieldPath; Message = message } |> Error let bug exc = Bug exc |> Error let operationNotAllowed operation reason = { Operation = operation; Reason = reason } |> Error let notFound name id = EntityNotFound (name, id) |> Error let entityInUse name = EntityIsInUse name |> Error let expectValidationError result = Result.mapError ValidationError result let expectOperationNotAllowedError result = Result.mapError OperationNotAllowed result let expectDataRelatedError result = Result.mapError DataError result let expectDataRelatedErrorAsync asyncResult = async { let! result = asyncResult return expectDataRelatedError result } (* Some type aliases for making code more readable and for preventing typo-kind of mistakes: so you don't devlare a validation function with plain `Error` type, for example. *) type AsyncResult<'a, 'error> = Async> type ValidationResult<'a> = Result<'a, ValidationError> type IoResult<'a> = AsyncResult<'a, DataRelatedError> type PipelineResult<'a> = AsyncResult<'a, Error> type IoQueryResult<'a> = Async<'a option> [] module Result = let combine results = let rec loop acc results = match results with | [] -> acc | result :: tail -> match result with | Error e -> Error e | Ok ok -> let acc = Result.map (fun oks -> ok :: oks) acc loop acc tail loop (Ok []) results let ofOption err opt = match opt with | Some v -> Ok v | None -> Error err ================================================ FILE: CardManagement.Console/CardManagement.Console.fsproj ================================================  Exe netcoreapp2.2 true PreserveNewest Always PreserveNewest Always ================================================ FILE: CardManagement.Console/Program.fs ================================================ // Learn more about F# at http://fsharp.org open System open CardManagement.CardDomainCommandModels open CardManagement.Infrastructure open CardManagement open CardManagement.CardWorkflow open CardManagement.CardDomainQueryModels open CardProgramBuilder [] let main argv = AppConfiguration.configureLog() let userId = Guid.Parse "b3f0a6f4-ee04-48ab-b838-9b3330c6bca9" let cardNumber = "1234123412341234" //let setDailyLimitModel = // { SetDailyLimitCardCommandModel.UserId = userId // Number = cardNumber // Limit = 500M} let createUser = { Name = "Daario Naharis" Address = { Country = "Russia" City = "The Great City Of Meereen" PostalCode = "12345" AddressLine1 = "Putrid Grove" AddressLine2 = ""} } let createCard = { CreateCardCommandModel.CardNumber = cardNumber ExpirationMonth = 11us ExpirationYear = 2023us Name = "Daario Naharis" UserId = userId } let topUpModel = { TopUpCommandModel.CardNumber = cardNumber TopUpAmount = 10000m } let paymentModel = { ProcessPaymentCommandModel.CardNumber = cardNumber PaymentAmount = 400M} let runWholeThingAsync = async { let! user = CardApi.createUser (userId, createUser) let! card = CardApi.createCard createCard let! card = CardApi.topUp (DateTimeOffset.UtcNow, topUpModel) let! card = CardApi.processPayment (DateTimeOffset.UtcNow, paymentModel) return () } runWholeThingAsync |> Async.RunSynchronously Console.ReadLine() |> ignore 0 // return an integer exit code ================================================ FILE: CardManagement.Console/appsettings.Development.json ================================================ { "Logging": { "LogLevel": { "Default": "Debug", "System": "Information", "Microsoft": "Information" } } } ================================================ FILE: CardManagement.Console/appsettings.json ================================================ { "MongoDB": { "Database": "CardDb", "Host": "localhost", "Port": 27017, "User": "root", "Password": "example" }, "Logging": { "LogLevel": { "Default": "Warning" } }, "AllowedHosts": "*" } ================================================ FILE: CardManagement.Data/CardDataPipeline.fs ================================================ namespace CardManagement.Data (* This is a composition root for data access layer. It combines model mapping and DB interaction, So it provides nice API for business logic layer: now they you don't have to do mapping in there, BL layer doesn't even know about entities existence, there's even no reference to DAL project from BL. And since we are dealing with functions, you don't even have to create interfaces to decouple this layers: every function has it's signature as an interface. *) module CardDataPipeline = open CardManagement.Common.Errors open CardManagement.CardDomain open CardManagement.Data.CardMongoConfiguration open FsToolkit.ErrorHandling open CardManagement.Common open System type CreateCardAsync = Card*AccountInfo -> IoResult type CreateUserAsync = UserInfo -> IoResult type ReplaceCardAsync = Card -> IoResult type ReplaceUserAsync = UserInfo -> IoResult type GetUserInfoAsync = UserId -> IoQueryResult type GetUserWithCardsAsync = UserId -> IoQueryResult type GetCardAsync = CardNumber -> IoQueryResult type GetCardWithAccinfoAsync = CardNumber -> IoQueryResult<(Card*AccountInfo)> type GetBalanceOperationsAsync = CardNumber * DateTimeOffset * DateTimeOffset -> Async type CreateBalanceOperationAsync = BalanceOperation -> IoResult let createCardAsync (mongoDb: MongoDb) : CreateCardAsync = fun (card, accountInfo) -> let cardEntity, _ = card |> DomainToEntityMapping.mapCardToEntity let accountInfoEntity = (card.CardNumber, accountInfo) |> DomainToEntityMapping.mapAccountInfoToEntity (cardEntity, accountInfoEntity) |> CommandRepository.createCardAsync mongoDb let createUserAsync (mongoDb: MongoDb) : CreateUserAsync = fun user -> user |> DomainToEntityMapping.mapUserToEntity |> CommandRepository.createUserAsync mongoDb let replaceCardAsync (mongoDb: MongoDb) : ReplaceCardAsync = fun card -> let cardEntity, maybeAccInfo = card |> DomainToEntityMapping.mapCardToEntity asyncResult { do! cardEntity |> CommandRepository.replaceCardAsync mongoDb match maybeAccInfo with | None -> return () | Some accInfo -> return! accInfo |> CommandRepository.replaceCardAccountInfoAsync mongoDb } let replaceUserAsync (mongoDb: MongoDb) : ReplaceUserAsync = fun user -> user |> DomainToEntityMapping.mapUserToEntity |> CommandRepository.replaceUserAsync mongoDb let getUserInfoAsync (mongoDb: MongoDb) : GetUserInfoAsync = fun userId -> async { let! userInfo = QueryRepository.getUserInfoAsync mongoDb userId return userInfo |> Option.map EntityToDomainMapping.mapUserInfoEntity } let getUserWithCards (mongoDb: MongoDb) : GetUserWithCardsAsync = fun userId -> async { let! userInfo = getUserInfoAsync mongoDb userId return! match userInfo with | None -> None |> async.Return | Some userInfo -> async { let! cardList = QueryRepository.getUserCardsAsync mongoDb userId let cards = List.map EntityToDomainMapping.mapCardEntity cardList let user = { UserInfo = userInfo Cards = cards } return Some user } } let getCardAsync (mongoDb: MongoDb) : GetCardAsync = fun cardNumber -> async { let! card = QueryRepository.getCardAsync mongoDb cardNumber.Value return card |> Option.map EntityToDomainMapping.mapCardEntity } let getCardWithAccountInfoAsync (mongoDb: MongoDb) : GetCardWithAccinfoAsync = fun cardNumber -> async { let! card = QueryRepository.getCardAsync mongoDb cardNumber.Value return card |> Option.map EntityToDomainMapping.mapCardEntityWithAccountInfo } let getBalanceOperationsAsync (mongoDb: MongoDb) : GetBalanceOperationsAsync = fun (cardNumber, fromDate, toDate) -> async { let! operations = QueryRepository.getBalanceOperationsAsync mongoDb (cardNumber.Value, fromDate, toDate) return List.map EntityToDomainMapping.mapBalanceOperationEntity operations } let createBalanceOperationAsync (mongoDb: MongoDb) : CreateBalanceOperationAsync = fun balanceOperation -> balanceOperation |> DomainToEntityMapping.mapBalanceOperationToEntity |> CommandRepository.createBalanceOperationAsync mongoDb ================================================ FILE: CardManagement.Data/CardDomainEntities.fs ================================================ namespace CardManagement.Data module CardDomainEntities = open System open MongoDB.Bson.Serialization.Attributes open System.Linq.Expressions open Microsoft.FSharp.Linq.RuntimeHelpers type UserId = Guid (* Over here we have entities for storing our stuff to DB. We use simple structures so they can be represented via JSON. Every entity has a different identifier, for User it's Guid `UserId` where for the card it's card number itself. However we still need some standard way for error messages, e.g. when we want to inform user when entity with specified Id wasn't found. So we use string `EntityId` property for representing that. *) [] type AddressEntity = { Country: string City: string PostalCode: string AddressLine1: string AddressLine2: string } with member this.EntityId = sprintf "%A" this [] type CardEntity = { [] CardNumber: string Name: string IsActive: bool ExpirationMonth: uint16 ExpirationYear: uint16 UserId: UserId } with member this.EntityId = this.CardNumber.ToString() // we use this Id comparer quotation (F# alternative to C# Expression) for updating entity by id, // since for different entities identifier has different name and type member this.IdComparer = <@ System.Func<_,_> (fun c -> c.CardNumber = this.CardNumber) @> [] type CardAccountInfoEntity = { [] CardNumber: string Balance: decimal DailyLimit: decimal } with member this.EntityId = this.CardNumber.ToString() member this.IdComparer = <@ System.Func<_,_> (fun c -> c.CardNumber = this.CardNumber) @> [] type UserEntity = { [] UserId: UserId Name: string Address: AddressEntity } with member this.EntityId = this.UserId.ToString() member this.IdComparer = <@ System.Func<_,_> (fun c -> c.UserId = this.UserId) @> // MongoDb allowes you to use objects as identifiers, so I used this instead of generating some GUID // which wouldn't mean anything other than something purely DB specific [] type BalanceOperationId = { Timestamp: DateTimeOffset CardNumber: string } [] type BalanceOperationEntity = { [] Id: BalanceOperationId BalanceChange: decimal NewBalance: decimal } with member this.EntityId = sprintf "%A" this.Id (* Now here's a little trick: by default F# doesn't allow to use nulls for records and discriminated unions. So you can't even use construct `if myRecord = null then ...`. Therefore your F# code is null safe. However we are living in .NET and right now we are using C# library to interact with MongoDB. This library will return nulls when there's nothing in DB, so we use this `Unchecked.defaultof<>`, which for reference types returns null. *) let isNullUnsafe (arg: 'a when 'a: not struct) = arg = Unchecked.defaultof<'a> // then we have this function to convert nulls to option, therefore we limited this // toxic null thing in here. let unsafeNullToOption a = if isNullUnsafe a then None else Some a (* Here's another cool feature of F#: we can do structural typing. Every entity now has `EntityId`, but instead of creating some dull interface and implementing it in every entity, we can define this 2 functions for retrieving `string EntityId` from every type that has it. Note that it works in COMPILE time, it's not reflection magic or something. For more examples of this thing take a look at https://gist.github.com/atsapura/fd9d7aa26e337eaa2f7f04d6cbb58ef6 *) let inline (|HasEntityId|) x = fun () -> (^a : (member EntityId: string) x) let inline entityId (HasEntityId f) = f() let inline (|HasIdComparer|) x = fun () -> (^a : (member IdComparer: Quotations.Expr>) x) // We need to convert F# quotations to C# expressions which C# mongo db driver understands. let inline idComparer (HasIdComparer id) = id() |> LeafExpressionConverter.QuotationToExpression |> unbox>> ================================================ FILE: CardManagement.Data/CardManagement.Data.fsproj ================================================  netcoreapp2.2 true ================================================ FILE: CardManagement.Data/CardMongoConfiguration.fs ================================================ namespace CardManagement.Data module CardMongoConfiguration = open CardManagement.Common open MongoDB.Driver type MongoSettings = { Database: string Host: string Port: int User: string Password: string } with member this.ConnectionString = if this.User |> isNullOrEmpty then sprintf "mongodb://%s:%i" this.Host this.Port else sprintf "mongodb://%s:%s@%s:%i" this.User this.Password this.Host this.Port let private createClient (connectionString:string) = MongoClient(connectionString) let getDatabase (config: MongoSettings) = let client = createClient config.ConnectionString client.GetDatabase(config.Database) let getSession (config: MongoSettings) = let client = createClient config.ConnectionString client.StartSession() type MongoDb = IMongoDatabase let [] internal cardCollection = "Card" let [] internal userCollection = "User" let [] internal cardAccountInfoCollection = "cardAccountInfo" let [] internal balanceOperationCollection = "BalanceOperation" type CardNumberString = string ================================================ FILE: CardManagement.Data/CommandRepository.fs ================================================ namespace CardManagement.Data module CommandRepository = open CardManagement.Common.Errors open CardMongoConfiguration open CardDomainEntities open System open MongoDB.Driver open System.Threading.Tasks open FsToolkit.ErrorHandling open System.Linq.Expressions type CreateUserAsync = UserEntity -> IoResult type CreateCardAsync = CardEntity * CardAccountInfoEntity -> IoResult type ReplaceUserAsync = UserEntity -> IoResult type ReplaceCardAsync = CardEntity -> IoResult type ReplaceCardAccountInfoAsync = CardAccountInfoEntity -> IoResult type CreateBalanceOperationAsync = BalanceOperationEntity -> IoResult let updateOptions = let opt = UpdateOptions() opt.IsUpsert <- false opt let private isDuplicateKeyException (ex: Exception) = ex :? MongoWriteException && (ex :?> MongoWriteException).WriteError.Category = ServerErrorCategory.DuplicateKey let rec private (|DuplicateKey|_|) (ex: Exception) = match ex with | :? MongoWriteException as ex when isDuplicateKeyException ex -> Some ex | :? MongoBulkWriteException as bex when bex.InnerException |> isDuplicateKeyException -> Some (bex.InnerException :?> MongoWriteException) | :? AggregateException as aex when aex.InnerException |> isDuplicateKeyException -> Some (aex.InnerException :?> MongoWriteException) | _ -> None let inline private executeInsertAsync (func: 'a -> Async) arg = async { try do! func(arg) return Ok () with | DuplicateKey ex -> return EntityAlreadyExists (arg.GetType().Name, (entityId arg)) |> Error } let inline private executeReplaceAsync (update: _ -> Task) arg = async { let! updateResult = update(idComparer arg, arg, updateOptions) |> Async.AwaitTask if not updateResult.IsAcknowledged then return sprintf "Update was not acknowledged for %A" arg |> failwith elif updateResult.MatchedCount = 0L then return EntityNotFound (arg.GetType().Name, entityId arg) |> Error else return Ok() } let createUserAsync (mongoDb : MongoDb) : CreateUserAsync = fun userEntity -> let insertUser = mongoDb.GetCollection(userCollection).InsertOneAsync >> Async.AwaitTask userEntity |> executeInsertAsync insertUser let createCardAsync (mongoDb: MongoDb) : CreateCardAsync = fun (card, accountInfo) -> let insertCardCommand = mongoDb.GetCollection(cardCollection).InsertOneAsync >> Async.AwaitTask let insertAccInfoCommand = mongoDb.GetCollection(cardAccountInfoCollection).InsertOneAsync >> Async.AwaitTask asyncResult { do! card |> executeInsertAsync insertCardCommand do! accountInfo |> executeInsertAsync insertAccInfoCommand } let replaceUserAsync (mongoDb: MongoDb) : ReplaceUserAsync = fun user -> let replaceCommand (selector: Expression<_>, user, options) = mongoDb.GetCollection(userCollection).ReplaceOneAsync(selector, user, options) user |> executeReplaceAsync replaceCommand let replaceCardAsync (mongoDb: MongoDb) : ReplaceCardAsync = fun card -> let replaceCommand (selector: Expression<_>, card, options) = mongoDb.GetCollection(cardCollection).ReplaceOneAsync(selector, card, options) card |> executeReplaceAsync replaceCommand let replaceCardAccountInfoAsync (mongoDb: MongoDb) : ReplaceCardAccountInfoAsync = fun accInfo -> let replaceCommand (selector: Expression<_>, accInfo, options) = mongoDb.GetCollection(cardAccountInfoCollection).ReplaceOneAsync(selector, accInfo, options) accInfo |> executeReplaceAsync replaceCommand let createBalanceOperationAsync (mongoDb: MongoDb) : CreateBalanceOperationAsync = fun balanceOperation -> let insert = mongoDb.GetCollection(balanceOperationCollection).InsertOneAsync >> Async.AwaitTask balanceOperation |> executeInsertAsync insert ================================================ FILE: CardManagement.Data/DomainToEntityMapping.fs ================================================ namespace CardManagement.Data (* Here however when we map domain types to entities we don't expect any kind of error, because domain types are valid by their definition. *) module DomainToEntityMapping = open CardManagement open CardDomain open CardDomainEntities open CardManagement.Common type MapCardAccountInfo = CardNumber * AccountInfo -> CardAccountInfoEntity type MapCard = Card -> CardEntity * CardAccountInfoEntity option type MapAddress = Address -> AddressEntity type MapUser = UserInfo -> UserEntity type MapBalanceOperation = BalanceOperation -> BalanceOperationEntity let mapAccountInfoToEntity : MapCardAccountInfo = fun (cardNumber, accountInfo) -> let limit = match accountInfo.DailyLimit with | Unlimited -> 0m | Limit limit -> limit.Value { Balance = accountInfo.Balance.Value DailyLimit = limit CardNumber = cardNumber.Value } let mapCardToEntity : MapCard = fun card -> let isActive = match card.AccountDetails with | Deactivated -> false | Active _ -> true let details = match card.AccountDetails with | Deactivated -> None | Active accountInfo -> mapAccountInfoToEntity (card.CardNumber, accountInfo) |> Some let card = { CardEntity.UserId = card.HolderId CardNumber = card.CardNumber.Value Name = card.Name.Value IsActive = isActive ExpirationMonth = (fst card.Expiration).ToNumber() ExpirationYear = (snd card.Expiration).Value } (card, details) let mapAddressToEntity : MapAddress = fun address -> { AddressEntity.Country = address.Country.ToString() City = address.City.Value PostalCode = address.PostalCode.Value AddressLine1 = address.AddressLine1 AddressLine2 = address.AddressLine2 } let mapUserToEntity : MapUser = fun user -> { UserId = user.Id Address = user.Address |> mapAddressToEntity Name = user.Name.Value } let mapBalanceOperationToEntity : MapBalanceOperation = fun operation -> { Id = { Timestamp = operation.Timestamp; CardNumber = operation.CardNumber.Value} NewBalance = operation.NewBalance.Value BalanceChange = operation.BalanceChange.ToDecimal() } ================================================ FILE: CardManagement.Data/EntityToDomainMapping.fs ================================================ namespace CardManagement.Data (* In our domain types we use types like LetterString, CardNumber etc. with built-in validation. Those types enforce us to go through validation process, so now we have to validate our entities during mapping. Normally we shouldn't get any error during this. We might get it if someone changes data in DB to something invalid directly or if we change validation rules. In any case we should know about such errors. *) module EntityToDomainMapping = open CardManagement open CardManagement.CardDomain open CardDomainEntities open Common.Errors open FsToolkit.ErrorHandling open CardManagement.Common.CommonTypes open CardManagement.Common // In here validation error means that invalid data was not provided by user, but instead // it was in our system. So if we have this error we throw exception let private throwOnValidationError entityName (err: ValidationError) = sprintf "Could not deserialize entity [%s]. Field [%s]. Message: %s." entityName err.FieldPath err.Message |> failwith let valueOrException (result: Result< 'a, ValidationError>) : 'a = match result with | Ok v -> v | Error e -> throwOnValidationError typeof<'a>.Name e let private validateCardEntityWithAccInfo (cardEntity: CardEntity, cardAccountEntity) : Result = result { let! cardNumber = CardNumber.create "cardNumber" cardEntity.CardNumber let! name = LetterString.create "name" cardEntity.Name let! month = Month.create "expirationMonth" cardEntity.ExpirationMonth let! year = Year.create "expirationYear" cardEntity.ExpirationYear let accountInfo = { Balance = Money cardAccountEntity.Balance DailyLimit = DailyLimit.ofDecimal cardAccountEntity.DailyLimit HolderId = cardEntity.UserId } let cardAccountInfo = if cardEntity.IsActive then accountInfo |> Active else Deactivated return ({ CardNumber = cardNumber Name = name HolderId = cardEntity.UserId Expiration = (month, year) AccountDetails = cardAccountInfo }, accountInfo) } let private validateCardEntity (cardEntity: CardEntity, cardAccountEntity) : Result = validateCardEntityWithAccInfo (cardEntity, cardAccountEntity) |> Result.map fst let mapCardEntity (cardEntity, cardAccountEntity) = validateCardEntity (cardEntity, cardAccountEntity) |> valueOrException let mapCardEntityWithAccountInfo (cardEntity, cardAccountEntity) = validateCardEntityWithAccInfo (cardEntity, cardAccountEntity) |> valueOrException let private validateAddressEntity (entity: AddressEntity) : Result = result { let! country = parseCountry entity.Country let! city = LetterString.create "city" entity.City let! postalCode = PostalCode.create "postalCode" entity.PostalCode return { Country = country City = city PostalCode = postalCode AddressLine1 = entity.AddressLine1 AddressLine2 = entity.AddressLine2 } } let mapAddressEntity entity = validateAddressEntity entity |> valueOrException let private validateUserInfoEntity (entity: UserEntity) : Result = result { let! name = LetterString.create "name" entity.Name let! address = validateAddressEntity entity.Address return { Id = entity.UserId Name = name Address = address} } let mapUserInfoEntity (entity: UserEntity) = validateUserInfoEntity entity |> valueOrException let mapUserEntity (entity: UserEntity) (cardEntities: (CardEntity * CardAccountInfoEntity) list) = result { let! userInfo = validateUserInfoEntity entity let! cards = List.map validateCardEntity cardEntities |> Result.combine return { UserInfo = userInfo Cards = cards } } |> valueOrException let mapBalanceOperationEntity (entity: BalanceOperationEntity) = result { let! cardNumber = entity.Id.CardNumber |> CardNumber.create "id.cardNumber" let! balanceChange = if entity.BalanceChange < 0M then -entity.BalanceChange |> MoneyTransaction.create |> Result.map Decrease else entity.BalanceChange |> MoneyTransaction.create |> Result.map Increase return { CardNumber = cardNumber NewBalance = Money entity.NewBalance Timestamp = entity.Id.Timestamp BalanceChange = balanceChange } } |> valueOrException ================================================ FILE: CardManagement.Data/QueryRepository.fs ================================================ namespace CardManagement.Data module QueryRepository = open System.Linq open CardDomainEntities open MongoDB.Driver open CardMongoConfiguration open System type IoQueryResult<'a> = Async<'a option> type GetCardAsync = MongoDb -> CardNumberString -> IoQueryResult<(CardEntity * CardAccountInfoEntity)> type GetUserAsync = MongoDb -> UserId -> IoQueryResult type GetUserCardsAsync = MongoDb -> UserId -> Async<(CardEntity * CardAccountInfoEntity) list> type GetBalanceOperationsAsync = MongoDb -> (CardNumberString * DateTimeOffset * DateTimeOffset) -> Async let private runSingleQuery dbQuery id = async { let! result = dbQuery id |> Async.AwaitTask return unsafeNullToOption result } let private getCardQuery (mongoDb: MongoDb) cardnumber = mongoDb.GetCollection(cardCollection) .Find(fun c -> c.CardNumber = cardnumber) .FirstOrDefaultAsync() let private getAccountInfoQuery (mongoDb: MongoDb) cardnumber = mongoDb.GetCollection(cardAccountInfoCollection) .Find(fun c -> c.CardNumber = cardnumber) .FirstOrDefaultAsync() let getCardAsync : GetCardAsync = fun mongoDb cardNumber -> let cardQuery = getCardQuery mongoDb let accInfoQuery = getAccountInfoQuery mongoDb async { let! card = runSingleQuery cardQuery cardNumber let! accInfo = runSingleQuery accInfoQuery cardNumber return match card, accInfo with | Some card, Some accInfo -> Some (card, accInfo) | _ -> None } let private getUserQuery (mongoDb: MongoDb) userId = mongoDb.GetCollection(userCollection) .Find(fun u -> u.UserId = userId) .FirstOrDefaultAsync() let getUserInfoAsync : GetUserAsync = fun mongoDb userId -> let query = getUserQuery mongoDb runSingleQuery query userId let private getUserCardsQuery (mongoDb: MongoDb) userId = mongoDb.GetCollection(cardCollection) .Find(fun c -> c.UserId = userId) .ToListAsync() let private getUserAccountInfosQuery (mongoDb: MongoDb) (cardNumbers: #seq<_>) = mongoDb.GetCollection(cardAccountInfoCollection) .Find(fun a -> cardNumbers.Contains a.CardNumber) .ToListAsync() let getUserCardsAsync : GetUserCardsAsync = fun mongoDb userId -> let cardsCall = getUserCardsQuery mongoDb >> Async.AwaitTask let getUserAccountInfosCall = getUserAccountInfosQuery mongoDb >> Async.AwaitTask async { let! cards = cardsCall userId let! accountInfos = Seq.map (fun (c: CardEntity) -> c.CardNumber) cards |> getUserAccountInfosCall // I didn't manage to make `Join` work, so here's some ugly hack let accountInfos = accountInfos.ToDictionary(fun a -> a.CardNumber) return [ for card in cards do yield (card, accountInfos.[card.CardNumber]) ] } let private getBalanceOperationsQuery (mongoDb: MongoDb) (cardNumber, fromDate, toDate) = mongoDb.GetCollection(balanceOperationCollection) .Find(fun bo -> bo.Id.CardNumber = cardNumber && bo.Id.Timestamp >= fromDate && bo.Id.Timestamp < toDate) .ToListAsync() let getBalanceOperationsAsync : GetBalanceOperationsAsync = fun mongoDb (cardNumber, fromDate, toDate) -> let operationsCall = getBalanceOperationsQuery mongoDb >> Async.AwaitTask async { let! result = operationsCall (cardNumber, fromDate, toDate) return result |> List.ofSeq } ================================================ FILE: CardManagement.Infrastructure/AppConfiguration.fs ================================================ namespace CardManagement.Infrastructure module AppConfiguration = open Microsoft.Extensions.Configuration open System.IO open System open CardManagement.Data.CardMongoConfiguration open Serilog open Serilog.Sinks.SystemConsole.Themes let stringSetting defaultValue str = Option.ofObj str |> Option.defaultValue defaultValue let intSetting defaultValue (str: string) = match Int32.TryParse str with | (false, _) -> defaultValue | (true, setting) -> setting let buildConfig() = ConfigurationBuilder() .SetBasePath(Directory.GetCurrentDirectory()) .AddJsonFile("appsettings.json", false, true) .Build() let [] logFormat = "[{Timestamp:dd/MM/yy HH:mm:ss.fff} {Level:u3}] {Message:lj}{NewLine}{Exception}" let configureLog() = let logger = LoggerConfiguration().WriteTo.Console(outputTemplate = logFormat, theme = AnsiConsoleTheme.Code).CreateLogger() Log.Logger <- logger let getMongoSettings (config: IConfigurationRoot) = let setting = sprintf "MongoDB:%s" let database = config.[setting "Database"] |> stringSetting "CardsDb" let port = config.[setting "Port"] |> intSetting 27017 let host = config.[setting "Host"] |> stringSetting "localhost" let user = config.[setting "User"] |> stringSetting "root" let password = config.[setting "Password"] |> stringSetting "example" { Database = database Host = host Port = port User = user Password = password } ================================================ FILE: CardManagement.Infrastructure/CardApi.fs ================================================ namespace CardManagement.Infrastructure module CardApi = open CardManagement open Logging let createUser arg = arg |> (CardWorkflow.createUser >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.createUser") let createCard arg = arg |> (CardWorkflow.createCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.createCard") let activateCard arg = arg |> (CardWorkflow.activateCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.activateCard") let deactivateCard arg = arg |> (CardWorkflow.deactivateCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.deactivateCard") let processPayment arg = arg |> (CardWorkflow.processPayment >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.processPayment") let topUp arg = arg |> (CardWorkflow.topUp >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.topUp") let setDailyLimit arg = arg |> (CardWorkflow.setDailyLimit >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.setDailyLimit") let getCard arg = arg |> (CardWorkflow.getCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.getCard") let getUser arg = arg |> (CardWorkflow.getUser >> CardProgramInterpreter.interpretSimple |> logifyResultAsync "CardApi.getUser") ================================================ FILE: CardManagement.Infrastructure/CardManagement.Infrastructure.fsproj ================================================  netcoreapp2.2 true ================================================ FILE: CardManagement.Infrastructure/CardProgramInterpreter.fs ================================================ namespace CardManagement.Infrastructure module CardProgramInterpreter = open CardManagement open CardManagement.Common open Logging open CardProgramBuilder open CardManagement.Data open Errors let private mongoSettings() = AppConfiguration.buildConfig() |> AppConfiguration.getMongoSettings let private getMongoDb() = mongoSettings() |> CardMongoConfiguration.getDatabase let private getCardAsync mongoDb = CardDataPipeline.getCardAsync mongoDb |> logifyPlainAsync "CardDataPipeline.getCardAsync" let private getUserAsync mongoDb = CardDataPipeline.getUserWithCards mongoDb |> logifyPlainAsync "CardDataPipeline.getUserWithCardsAsync" let private getCardWithAccInfoAsync mongoDb = CardDataPipeline.getCardWithAccountInfoAsync mongoDb |> logifyPlainAsync "CardDataPipeline.getCardWithAccountInfoAsync" let private replaceCardAsync mongoDb = CardDataPipeline.replaceCardAsync mongoDb |> logifyResultAsync "CardDataPipeline.replaceCardAsync" let private getBalanceOperationsAsync mongoDb = CardDataPipeline.getBalanceOperationsAsync mongoDb |> logifyPlainAsync "CardDataPipeline.getBalanceOperationsAsync" let private saveBalanceOperationAsync mongoDb = CardDataPipeline.createBalanceOperationAsync mongoDb |> logifyResultAsync "CardDataPipeline.createBalanceOperationAsync" let private createCardAsync mongoDb = CardDataPipeline.createCardAsync mongoDb |> logifyResultAsync "CardPipeline.createCardAsync" let private createUserAsync mongoDb = CardDataPipeline.createUserAsync mongoDb |> logifyResultAsync "CardDataPipeline.createUserAsync" (* Here is where we inject dependencies. Unlike classic IoC container it checks that you have all the dependencies in compile time. *) let rec private interpretCardProgram mongoDb prog = match prog with | GetCard (cardNumber, next) -> cardNumber |> getCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetCardWithAccountInfo (number, next) -> number |> getCardWithAccInfoAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | CreateCard ((card,acc), next) -> (card, acc) |> createCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | ReplaceCard (card, next) -> card |> replaceCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetUser (id, next) -> getUserAsync mongoDb id |> bindAsync (next >> interpretCardProgram mongoDb) | CreateUser (user, next) -> user |> createUserAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetBalanceOperations (request, next) -> getBalanceOperationsAsync mongoDb request |> bindAsync (next >> interpretCardProgram mongoDb) | SaveBalanceOperation (op, next) -> saveBalanceOperationAsync mongoDb op |> bindAsync (next >> interpretCardProgram mongoDb) | Stop a -> async.Return a let interpret prog = try let interpret = interpretCardProgram (getMongoDb()) interpret prog with | failure -> Bug failure |> Error |> async.Return let interpretSimple prog = try let interpret = interpretCardProgram (getMongoDb()) async { let! result = interpret prog return Ok result } with | failure -> Bug failure |> Error |> async.Return ================================================ FILE: CardManagement.Infrastructure/Logging.fs ================================================ namespace CardManagement.Infrastructure (* All the logging is defined in here, except for configuration. The idea is simple: you use functions `logify` and `logifyAsync` to wrap functions you want to log. It will print start of function execution and execution result upon finishing. *) module Logging = open CardManagement.Common open Serilog open Errors open ErrorMessages let private funcFinishedWithError funcName = sprintf "%s finished with error: %s" funcName let logDataError funcName e = dataRelatedErrorMessage e |> funcFinishedWithError funcName |> Log.Warning let logValidationError funcName e = validationMessage e |> funcFinishedWithError funcName |> Log.Information let logOperationNotAllowed funcName e = operationNotAllowedMessage e |> funcFinishedWithError funcName |> Log.Warning let logError funcName e = match e with | DataError e -> logDataError funcName e | ValidationError e -> logValidationError funcName e | OperationNotAllowed e -> logOperationNotAllowed funcName e | Bug _ -> let errorMessage = errorMessage e Log.Error(errorMessage) let private logResult funcName result = match result with | Ok ok -> sprintf "%s finished with result\n%A" funcName ok |> Log.Information | Error e -> match box e with | :? DataRelatedError as er -> logDataError funcName er | :? Error as er -> logError funcName er | :? ValidationError as er -> logValidationError funcName er | :? OperationNotAllowedError as er -> logOperationNotAllowed funcName er | e -> sprintf "%A" e |> Log.Error let logifyResult funcName func x = sprintf "start %s with arg\n%A" funcName x |> Log.Information let result = func x logResult funcName result result let logifyResultAsync funcName funcAsync x = async { sprintf "start %s with arg\n%A" funcName x |> Log.Information let! result = funcAsync x logResult funcName result return result } let logifyPlainAsync funcName funcAsync x = async { sprintf "start %s with arg\n%A" funcName x |> Log.Information let! result = funcAsync x sprintf "%s finished with result\n%A" funcName result |> Log.Information return result } ================================================ FILE: CardManagement.sln ================================================  Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.28307.572 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CardManagement", "CardManagement\CardManagement.fsproj", "{5438E2FD-4002-4BDF-859D-47F2E1B536B6}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CardManagement.Common", "CardManagement.Common\CardManagement.Common.fsproj", "{5F07D8E7-80FE-4C45-9F06-280EF75A51DF}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CardManagement.Api", "CardManagement.Api\CardManagement.Api\CardManagement.Api.fsproj", "{83F3B3AF-970D-4D14-ADED-93E34820EC03}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CardManagement.Data", "CardManagement.Data\CardManagement.Data.fsproj", "{0DB9F3A2-1FB0-42F5-BFDB-528367FFC44E}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CardManagement.Infrastructure", "CardManagement.Infrastructure\CardManagement.Infrastructure.fsproj", "{69C44B43-EC3A-461D-9587-1D7D860394A1}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CardManagement.Console", "CardManagement.Console\CardManagement.Console.fsproj", "{E3DB1DF2-673E-4627-927B-95E094BCCC2F}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {5438E2FD-4002-4BDF-859D-47F2E1B536B6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5438E2FD-4002-4BDF-859D-47F2E1B536B6}.Debug|Any CPU.Build.0 = Debug|Any CPU {5438E2FD-4002-4BDF-859D-47F2E1B536B6}.Release|Any CPU.ActiveCfg = Release|Any CPU {5438E2FD-4002-4BDF-859D-47F2E1B536B6}.Release|Any CPU.Build.0 = Release|Any CPU {5F07D8E7-80FE-4C45-9F06-280EF75A51DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5F07D8E7-80FE-4C45-9F06-280EF75A51DF}.Debug|Any CPU.Build.0 = Debug|Any CPU {5F07D8E7-80FE-4C45-9F06-280EF75A51DF}.Release|Any CPU.ActiveCfg = Release|Any CPU {5F07D8E7-80FE-4C45-9F06-280EF75A51DF}.Release|Any CPU.Build.0 = Release|Any CPU {83F3B3AF-970D-4D14-ADED-93E34820EC03}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {83F3B3AF-970D-4D14-ADED-93E34820EC03}.Debug|Any CPU.Build.0 = Debug|Any CPU {83F3B3AF-970D-4D14-ADED-93E34820EC03}.Release|Any CPU.ActiveCfg = Release|Any CPU {83F3B3AF-970D-4D14-ADED-93E34820EC03}.Release|Any CPU.Build.0 = Release|Any CPU {0DB9F3A2-1FB0-42F5-BFDB-528367FFC44E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {0DB9F3A2-1FB0-42F5-BFDB-528367FFC44E}.Debug|Any CPU.Build.0 = Debug|Any CPU {0DB9F3A2-1FB0-42F5-BFDB-528367FFC44E}.Release|Any CPU.ActiveCfg = Release|Any CPU {0DB9F3A2-1FB0-42F5-BFDB-528367FFC44E}.Release|Any CPU.Build.0 = Release|Any CPU {69C44B43-EC3A-461D-9587-1D7D860394A1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {69C44B43-EC3A-461D-9587-1D7D860394A1}.Debug|Any CPU.Build.0 = Debug|Any CPU {69C44B43-EC3A-461D-9587-1D7D860394A1}.Release|Any CPU.ActiveCfg = Release|Any CPU {69C44B43-EC3A-461D-9587-1D7D860394A1}.Release|Any CPU.Build.0 = Release|Any CPU {E3DB1DF2-673E-4627-927B-95E094BCCC2F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {E3DB1DF2-673E-4627-927B-95E094BCCC2F}.Debug|Any CPU.Build.0 = Debug|Any CPU {E3DB1DF2-673E-4627-927B-95E094BCCC2F}.Release|Any CPU.ActiveCfg = Release|Any CPU {E3DB1DF2-673E-4627-927B-95E094BCCC2F}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {73984EBC-C77E-4D1B-BB0C-A1E8714711C1} EndGlobalSection EndGlobal ================================================ FILE: README.md ================================================ # Card Management ## Why? This is a "real world" example application, written entirely in F#. The goal is to create a best practice for building applications or at least give a reasonable manual to design one. ## Summary It's a very simple bank application. Here you can - Create/Read users - Create/Read cards for those users - Set daily limits for cards - Top up balance - Process payments (according to your current balance, daily limit and today's spendings) ## Tech To run this thing you'll need: - .NET Core 2.2+ - Docker - Visual Studio 2017+ or VS Code with Ionide plugin or Rider with F# plugin Database here is MongoDb, hosted in docker container. So you just have to navigate to `docker` folder and run `docker-compose up`. That's it. For web api `Giraffe` framework is used. You can also play with it using `CardManagement.Console` project. ## Project overview There are several projects in this solution, in order of referencing: - CardManagement.Common. Self explanatory, I guess. - CardManagement. This is a business logic project, a core of this application. Domain types, actions and composition root for this layer - CardManagement.Data. Data access layer. Contains entities, db interaction functions and composition root for this layer. - CardManagement.Infrastructure. In here you'll find a global composition root, logging, app configuration functions. - CardManagement.Console/CardManagement.Api. Entry point for using global composition root from infrastructure. ## Detailed description [Here's](https://github.com/atsapura/CardManagement/blob/master/article/Fighting.Complexity.md) long and boring explanation of why anyone would even bother to use F# for web api and tips on how to do it in such a way so you don't blow your head off. ================================================ FILE: SampleCalls.http ================================================ ### Create user POST https://localhost:5001/users Content-Type: application/json Content-Length: 136 {"name": "Uncle Vesemir", "address":{"country":"Finland", "city": "Helsinki", "postalCode": "12345", "addressLine1":"Redenia st. 156"}} ### Create card POST https://localhost:5001/cards Content-Type: application/json Content-Length: 162 {"cardNumber": "4111111111111111", "name": "Uncle Vesemir", "expirationMonth": "8", "expirationYear":"2024", "userId":"69f79c5b-d31b-4a03-a038-062a10b59ad1"} ### top up PATCH https://localhost:5001/cards/topUp Content-Type: application/json Content-Length: 55 {"cardNumber": "4111111111111111", "topUpAmount":8900} ### pay PATCH https://localhost:5001/cards/processPayment Content-Type: application/json Content-Length: 55 {"cardNumber": "1234123412341234","paymentAmount":137} ### set daily limit PATCH https://localhost:5001/cards/setDailyLimit Content-Type: application/json Content-Length: 52 {"cardNumber": "1234123412341234","limit":900} ### deactivate PATCH https://localhost:5001/cards/deactivate Content-Type: application/json Content-Length: 35 {"cardNumber": "1234123412341234"} ### activate PATCH https://localhost:5001/cards/activate Content-Type: application/json Content-Length: 35 {"cardNumber": "1234123412341234"} ================================================ FILE: article/Fighting.Complexity.md ================================================ # Fighting complexity in software development ## What's this about After working on different projects, I've noticed that every one of them had some common problems, regardless of domain, architecture, code convention and so on. Those problems weren't challenging, just a tedious routine: making sure you didn't miss anything stupid and obvious. Instead of doing this routine on a daily basis I became obsessed with seeking solution: some development approach or code convention or whatever that will help me to design a project in a way that will prevent those problems from happening, so I can focus on interesting stuff. That's the goal of this article: to describe those problems and show you that mix of tools and approaches that I found to solve them. ## Problems we face While developing software we face a lot of difficulties along the way: unclear requirements, miscommunication, poor development process and so on. We also face some technical difficulties: legacy code slows us down, scaling is tricky, some bad decisions of the past kick us in the teeth today. All of them can be if not eliminated then significantly reduced, but there's one fundamental problem you can do nothing about: the complexity of your system. The idea of a system you are developing itself is always complex, whether you understand it or not. Even when you're making _yet another CRUD application_, there're always some edge cases, some tricky things, and from time to time someone asks "Hey, what's gonna happen if I do this and this under these circumstances?" and you say "Hm, that's a very good question.". Those tricky cases, shady logic, validation and access managing - all that adds up to your big idea. Quite often that idea is so big that it doesn't fit in one head, and that fact alone brings problems like miscommunication. But let's be generous and assume that this team of domain experts and business analysts communicates clearly and produces fine consistent requirements. Now we have to implement them, to express that complex idea in our code. Now that code is another system, way more complicated than original idea we had in mind(s). How so? It faces reality: technical limitations force you to deal with highload, data consistency and availability on top of implementing actual business logic. As you can see the task is pretty challenging, and now we need proper tools to deal with it. A programming language is just another tool, and like with every other tool, it's not just about the quality of it, it's probably even more about the tool fitting the job. You might have the best screwdriver there is, but if you need to put some nails into wood, a crappy hammer would be better, right? ## Technical aspects Most popular languages today are object oriented. When someone makes an introduction to OOP they usually use examples: Consider a car, which is an object from the real world. It has various properties like brand, weight, color, max speed, current speed and so on. To reflect this object in our program we gather those properties in one class. Properties can be permanent or mutable, which together form both current state of this object and some boundaries in which it may vary. However combining those properties isn't enough, since we have to check that current state makes sense, e.g. current speed doesn't exceed max speed. To make sure of that we attach some logic to this class, mark properties as private to prevent anyone from creating illegal state. As you can see objects are about their internal state and life cycle. So those three pillars of OOP make perfect sense in this context: we use inheritance to reuse certain state manipulations, encapsulation for state protection and polymorphism for treating similar objects the same way. Mutability as a default also makes sense, since in this context immutable object can't have a life cycle and has always one state, which isn't the most common case. Thing is when you look at a typical web application of these days, it doesn't deal with objects. Almost everything in our code has either eternal lifetime or no proper lifetime at all. Two most common kinds of "objects" are some sort of services like `UserService`, `EmployeeRepository` or some models/entities/DTOs or whatever you call them. Services have no logical state inside them, they die and born again exactly the same, we just recreate the dependency graph with a new database connection. Entities and models don't have any behavior attached to them, they are merely bundles of data, their mutability doesn't help but quite the opposite. Therefore key features of OOP aren't really useful for developing this kind of applications. What happens in a typical web app is data flowing: validation, transformation, evaluation and so on. And there's a paradigm that fits perfectly for that kind of job: functional programming. And there's a proof for that: all the modern features in popular languages today come from there: `async/await`, lambdas and delegates, reactive programming, discriminated unions (enums in swift or rust, not to be confused with enums in java or .net), tuples - all that is from FP. However those are just crumbles, it's very nice to have them, but there's more, way more. Before I go any deeper, there's a point to be made. Switching to a new language, especially a new paradigm, is an investment for developers and therefore for business. Doing foolish investments won't give you anything but troubles, but reasonable investments may be the very thing that'll keep you afloat. ## Tools we have and what they give us A lot of us prefer languages with static typing. The reason for that is simple: compiler takes care of tedious checks like passing proper parameters to functions, constructing our entities correctly and so on. These checks come for free. Now, as for the stuff that compiler can't check, we have a choice: hope for the best or make some tests. Writing tests means money, and you don't pay just once per test, you have to maintain them. Besides, people get sloppy, so every once in a while we get false positive and false negative results. The more tests you have to write the lower is the average quality of those tests. There's another problem: in order to test something, you have to know and remember that that thing should be tested, but the bigger your system is the easier it is to miss something. However compiler is only as good as the type system of the language. If it doesn't allow you to express something in static ways, you have to do that in runtime. Which means tests, yes. It's not only about type system though, syntax and small sugar features are very important too, because at the end of the day we want to write as little code as possible, so if some approach requires you to write ten times more lines, well, no one is gonna use it. That's why it's important that language you choose has the fitting set of features and tricks - well, right focus overall. If it doesn't - instead of using its features to fight original challenges like complexity of your system and changing requirements, you gonna be fighting the language as well. And it all comes down to money, since you pay developers for their time. The more problem they have to solve, the more time they gonna need and the more developers you are gonna need. Finally we are about to see some code to prove all that. I'm happen to be a .NET developer, so code samples are gonna be in C# and F#, but the general picture would look more or less the same in other popular OOP and FP languages. ## Let the coding begin We are gonna build a web application for managing credit cards. Basic requirements: - Create/Read users - Create/Read credit cards - Activate/Deactivate credit cards - Set daily limit for cards - Top up balance - Process payments (considering balance, card expiration date, active/deactivated state and daily limit) For the sake of simplicity we are gonna use one card per account and we will skip authorization. But for the rest we're gonna build capable application with validation, error handling, database and web api. So let's get down to our first task: design credit cards. First, let's see what it would look like in C# ```csharp public class Card { public string CardNumber {get;set;} public string Name {get;set;} public int ExpirationMonth {get;set;} public int ExpirationYear {get;set;} public bool IsActive {get;set;} public AccountInfo AccountInfo {get;set;} } public class AccountInfo { public decimal Balance {get;set;} public string CardNumber {get;set;} public decimal DailyLimit {get;set;} } ``` But that's not enough, we have to add validation, and commonly it's being done in some `Validator`, like the one from `FluentValidation`. The rules are simple: - Card number is required and must be a 16-digit string. - Name is required and must contain only letters and can contain spaces in the middle. - Month and year have to satisfy boundaries. - Account info must be present when the card is active and absent when the card is deactivated. If you are wondering why, it's simple: when card is deactivated, it shouldn't be possible to change balance or daily limit. ```csharp public class CardValidator : IValidator { internal static CardNumberRegex = new Regex("^[0-9]{16}$"); internal static NameRegex = new Regex("^[\w]+[\w ]+[\w]+$"); public CardValidator() { RuleFor(x => x.CardNumber) .Must(c => !string.IsNullOrEmpty(c) && CardNumberRegex.IsMatch(c)) .WithMessage("oh my"); RuleFor(x => x.Name) .Must(c => !string.IsNullOrEmpty(c) && NameRegex.IsMatch(c)) .WithMessage("oh no"); RuleFor(x => x.ExpirationMonth) .Must(x => x >= 1 && x <= 12) .WithMessage("oh boy"); RuleFor(x => x.ExpirationYear) .Must(x => x >= 2019 && x <= 2023) .WithMessage("oh boy"); RuleFor(x => x.AccountInfo) .Null() .When(x => !x.IsActive) .WithMessage("oh boy"); RuleFor(x => x.AccountInfo) .NotNull() .When(x => x.IsActive) .WithMessage("oh boy"); } } ``` Now there're several problems with this approach: - Validation is separated from type declaration, which means to see the full picture of _what card really is_ we have to navigate through code and recreate this image in our head. It's not a big problem when it happens only once, but when we have to do that for every single entity in a big project, well, it's very time consuming. - This validation isn't forced, we have to keep in mind to use it everywhere. We can ensure this with tests, but then again, you have to remember about it when you write tests. - When we want to validate card number in other places, we have to do same thing all over again. Sure, we can keep regex in a common place, but still we have to call it in every validator. In F# we can do it in a different way: ```fsharp // First we define a type for CardNumber with private constructor // and public factory which receives string and returns `Result`. // Normally we would use `ValidationError` instead, but string is good enough for example type CardNumber = private CardNumber of string with member this.Value = match this with CardNumber s -> s static member create str = match str with | (null|"") -> Error "card number can't be empty" | str -> if cardNumberRegex.IsMatch(str) then CardNumber str |> Ok else Error "Card number must be a 16 digits string" // Then in here we express this logic "when card is deactivated, balance and daily limit manipulations aren't available`. // Note that this is way easier to grasp that reading `RuleFor()` in validators. type CardAccountInfo = | Active of AccountInfo | Deactivated // And then that's it. The whole set of rules is here, and it's described in a static way. // We don't need tests for that, the compiler is our test. And we can't accidentally miss this validation. type Card = { CardNumber: CardNumber Name: LetterString // LetterString is another type with built-in validation HolderId: UserId Expiration: (Month * Year) AccountDetails: CardAccountInfo } ``` Of course some things from here we can do in C#. We can create `CardNumber` class which will throw `ValidationException` in there too. But that trick with `CardAccountInfo` can't be done in C# in easy way. Another thing - C# heavily relies on exceptions. There are several problems with that: - Exceptions have "go to" semantics. One moment you're here in this method, another - you ended up in some global handler. - They don't appear in method signature. Exceptions like `ValidationException` or `InvalidUserOperationException` are part of the contract, but you don't know that until you read _implementation_. And it's a major problem, because quite often you have to use code written by someone else, and instead of reading just signature, you have to navigate all the way to the bottom of the call stack, which takes a lot of time. And this is what bothers me: whenever I implement some new feature, implementation process itself doesn't take much time, the majority of it goes to two things: - Reading other people's code and figuring out business logic rules. - Making sure nothing is broken. It may sound like a symptom of a bad code design, but same thing what happens even on decently written projects. Okay, but we can try use same `Result` thing in C#. The most obvious implementation would look like this: ```csharp public class Result { public TOk Ok {get;set;} public TError Error {get;set;} } ``` and it's a pure garbage, it doesn't prevent us from setting both `Ok` and `Error` and allows error to be completely ignored. The proper version would be something like this: ```csharp public abstract class Result { public abstract bool IsOk { get; } private sealed class OkResult : Result { public readonly TOk _ok; public OkResult(TOk ok) { _ok = ok; } public override bool IsOk => true; } private sealed class ErrorResult : Result { public readonly TError _error; public ErrorResult(TError error) { _error = error; } public override bool IsOk => false; } public static Result Ok(TOk ok) => new OkResult(ok); public static Result Error(TError error) => new ErrorResult(error); public Result Map(Func map) { if (this.IsOk) { var value = ((OkResult)this)._ok; return Result.Ok(map(value)); } else { var value = ((ErrorResult)this)._error; return Result.Error(value); } } public Result MapError(Func mapError) { if (this.IsOk) { var value = ((OkResult)this)._ok; return Result.Ok(value); } else { var value = ((ErrorResult)this)._error; return Result.Error(mapError(value)); } } } ``` Pretty cumbersome, right? And I didn't even implement the `void` versions for `Map` and `MapError`. The usage would look like this: ```csharp void Test(Result result) { var squareResult = result.Map(x => x * x); } ``` Not so bad, uh? Well, now imagine you have three results and you want to do something with them when all of them are `Ok`. Nasty. So that's hardly an option. F# version: ```fsharp // this type is in standard library, but declaration looks like this: type Result<'ok, 'error> = | Ok of 'ok | Error of 'error // and usage: let test res1 res2 res3 = match res1, res2, res3 with | Ok ok1, Ok ok2, Ok ok3 -> printfn "1: %A 2: %A 3: %A" ok1 ok2 ok3 | _ -> printfn "fail" ``` Basically, you have to choose whether you write reasonable amount of code, but the code is obscure, relies on exceptions, reflection, expressions and other "magic", or you write much more code, which is hard to read, but it's more durable and straight forward. When such a project gets big you just can't fight it, not in languages with C#-like type systems. Let's consider a simple scenario: you have some entity in your codebase for a while. Today you want to add a new required field. Naturally you need to initialize this field everywhere this entity is created, but compiler doesn't help you at all, since class is mutable and `null` is a valid value. And libraries like `AutoMapper` make it even harder. This mutability allows us to partially initialize objects in one place, then push it somewhere else and continue initialization there. That's another source of bugs. Meanwhile language feature comparison is nice, however it's not what this article about. If you're interested in it, I covered that topic in my [previous article](https://medium.com/@liman.rom/f-spoiled-me-or-why-i-dont-enjoy-c-anymore-39e025035a98). But language features themselves shouldn't be a reason to switch technology. So that brings us to these questions: 1. Why do we really need to switch from modern OOP? 2. Why should we switch to FP? Answer to first question is using common OOP languages for modern applications gives you a lot of troubles, because they were designed for a different purposes. It results in time and money you spend to fight their design along with fighting complexity of your application. And the second answer is FP languages give you an easy way to design your features so they work like a clock, and if a new feature breaks existing logic, it breaks the code, hence you know that immediately. *** However those answers aren't enough. As my friend pointed out during one of our discussions, switching to FP would be useless when you don't know best practices. Our big industry produced tons of articles, books and tutorials about designing OOP applications, and we have production experience with OOP, so we know what to expect from different approaches. Unfortunately, it's not the case for functional programming, so even if you switch to FP, your first attempts most likely would be awkward and certainly wouldn't bring you the desired result: fast and painless developing of complex systems. Well, that's precisely what this article is about. As I said, we're gonna build production-like application to see the difference. ## How do we design application? A lot of this ideas I used in design process I borrowed from the great book [Domain Modeling Made Functional](https://www.amazon.com/Domain-Modeling-Made-Functional-Domain-Driven/dp/1680502549), so I strongly encourage you to read it. Full source code with comments is [here](https://github.com/atsapura/CardManagement). Naturally, I'm not going to put all of it in here, so I'll just walk through key points. We'll have 4 main projects: business layer, data access layer, infrastructure and, of course, common. Every solution has it, right? We begin with modeling our domain. At this point we don't know and don't care about database. It's done on purpose, because having specific database in mind we tend to design our domain according to it, we bring this entity-table relation in business layer, which later brings problems. You only need implement mapping `domain -> DAL` once, while wrong design will trouble us constantly until the point we fix it. So here's what we do: we create a project named `CardManagement` (very creative, I know), and immediately turn on the setting `true` in project file. Why do we need this? Well, we're gonna use discriminated unions heavily, and when you do pattern matching, compiler gives us a warning, if we didn't cover all the possible cases: ```fsharp let fail result = match result with | Ok v -> printfn "%A" v // warning: Incomplete pattern matches on this expression. For example, the value 'Error' may indicate a case not covered by the pattern(s). ``` With this setting on, this code just won't compile, which is exactly what we need, when we extend existing functionality and want it to be adjusted everywhere. Next thing we do is creating module (it compiles in a static class) `CardDomain`. In this file we describe domain types and nothing more. Keep in mind that in F#, code and file order matters: by default you can use only what you declared earlier. ### Domain types We begin defining our types with `CardNumber` I showed before, although we're gonna need more practical `Error` than just a string, so we'll use `ValidationError`. ```fsharp type ValidationError = { FieldPath: string Message: string } let validationError field message = { FieldPath = field; Message = message } // Actually we should use here Luhn's algorithm, but I leave it to you as an exercise, // so you can see for yourself how easy is updating code to new requirements. let private cardNumberRegex = new Regex("^[0-9]{16}$", RegexOptions.Compiled) type CardNumber = private CardNumber of string with member this.Value = match this with CardNumber s -> s static member create fieldName str = match str with | (null|"") -> validationError fieldName "card number can't be empty" | str -> if cardNumberRegex.IsMatch(str) then CardNumber str |> Ok else validationError fieldName "Card number must be a 16 digits string" ``` Then we of course define `Card` which is the heart of our domain. We know that card has some permanent attributes like number, expiration date and name on card, and some changeable information like balance and daily limit, so we encapsulate that changeable info in other type: ```fsharp type AccountInfo = { HolderId: UserId Balance: Money DailyLimit: DailyLimit } type Card = { CardNumber: CardNumber Name: LetterString HolderId: UserId Expiration: (Month * Year) AccountDetails: CardAccountInfo } ``` Now, there're several types here, which we haven't declared yet: 1. **Money** We could use `decimal` (and we will, but no directly), but `decimal` is less descriptive. Besides, it can be used for representation of other things than money, and we don't want it to be mixed up. So we use custom type `type [] Money = Money of decimal `. 2. **DailyLimit** Daily limit can be either set to a specific amount or to be absent at all. If it's present, it must be positive. Instead of using `decimal` or `Money` we define this type: ```fsharp [] type DailyLimit = private // private constructor so it can't be created directly outside of module | Limit of Money | Unlimited with static member ofDecimal dec = if dec > 0m then Money dec |> Limit else Unlimited member this.ToDecimalOption() = match this with | Unlimited -> None | Limit limit -> Some limit.Value ``` It is more descriptive than just implying that `0M` means that there's no limit, since it also could mean that you can't spend money on this card. The only problem is since we've hidden the constructor, we can't do pattern matching. But no worries, we can use [Active Patterns](https://fsharpforfunandprofit.com/posts/convenience-active-patterns/): ```fsharp let (|Limit|Unlimited|) limit = match limit with | Limit dec -> Limit dec | Unlimited -> Unlimited ``` Now we can pattern match `DailyLimit` everywhere as a regular DU. 3. **LetterString** That one is simple. We use same technique as in `CardNumber`. One little thing though: `LetterString` is hardly about credit cards, it's a rather thing and we should move it in `Common` project in `CommonTypes` module. Time comes we move `ValidationError` into separate place as well. 4. **UserId** That one is just an alias `type UserId = System.Guid`. We use it for descriptiveness only. 5. **Month and Year** Those have to go to `Common` too. `Month` is gonna be a discriminated union with methods to convert it to and from `unsigned int16`, `Year` is going to be like `CardNumber` but for `uint16` instead of string. Now let's finish our domain types declaration. We need `User` with some user information and card collection, we need balance operations for top-ups and payments. ```fsharp type UserInfo = { Name: LetterString Id: UserId Address: Address } type User = { UserInfo : UserInfo Cards: Card list } [] type BalanceChange = | Increase of increase: MoneyTransaction // another common type with validation for positive amount | Decrease of decrease: MoneyTransaction with member this.ToDecimal() = match this with | Increase i -> i.Value | Decrease d -> -d.Value [] type BalanceOperation = { CardNumber: CardNumber Timestamp: DateTimeOffset BalanceChange: BalanceChange NewBalance: Money } ``` Good, we designed our types in a way that invalid state is unrepresentable. Now whenever we deal with instance of any of these types we are sure that data in there is valid and we don't have to validate it again. Now we can proceed to business logic! ### Business logic We'll have an unbreakable rule here: all business logic is gonna be coded in **pure functions**. A pure function is a function which satisfies following criteria: - The only thing it does is computes output value. It has no side effects at all. - It always produces same output for the same input. Hence pure functions don't throw exceptions, don't produce random values, don't interact with outside world at any form, be it database or a simple `DateTime.Now`. Of course interacting with impure function automatically renders calling function impure. So what shall we implement? Here's a list of requirements we have: - **Activate/deactivate card** - **Process payments** We can process payment if: 1. Card isn't expired 2. Card is active 3. There's enough money for the payment 4. Spendings for today haven't exceeded daily limit. - **Top up balance** We can top up balance for active and not expired card. - **Set daily limit** User can set daily limit if card isn't expired and is active. When operation can't be completed we have to return an error, so we need to define `OperationNotAllowedError`: ```fsharp type OperationNotAllowedError = { Operation: string Reason: string } // and a helper function to wrap it in `Error` which is a case for `Result<'ok,'error> type let operationNotAllowed operation reason = { Operation = operation; Reason = reason } |> Error ``` In this module with business logic that would be _the only_ type of error we return. We don't do validation in here, don't interact with database - just executing operations if we can otherwise return `OperationNotAllowedError`. Full module can be found [here](https://github.com/atsapura/CardManagement/blob/master/CardManagement/CardActions.fs). I'll list here the trickiest case here: `processPayment`. We have to check for expiration, active/deactivated status, money spent today and current balance. Since we can't interact with outer world, we have to pass all the necessary information as parameters. That way this _logic_ would be very easy to test, and allows you to do [property based testing](https://github.com/fscheck/FsCheck). ```fsharp let processPayment (currentDate: DateTimeOffset) (spentToday: Money) card (paymentAmount: MoneyTransaction) = // first check for expiration if isCardExpired currentDate card then cardExpiredMessage card.CardNumber |> processPaymentNotAllowed else // then active/deactivated match card.AccountDetails with | Deactivated -> cardDeactivatedMessage card.CardNumber |> processPaymentNotAllowed | Active accInfo -> // if active then check balance if paymentAmount.Value > accInfo.Balance.Value then sprintf "Insufficent funds on card %s" card.CardNumber.Value |> processPaymentNotAllowed else // if balance is ok check limit and money spent today match accInfo.DailyLimit with | Limit limit when limit < spentToday + paymentAmount -> sprintf "Daily limit is exceeded for card %s with daily limit %M. Today was spent %M" card.CardNumber.Value limit.Value spentToday.Value |> processPaymentNotAllowed (* We could use here the ultimate wild card case like this: | _ -> but it's dangerous because if a new case appears in `DailyLimit` type, we won't get a compile error here, which would remind us to process this new case in here. So this is a safe way to do the same thing. *) | Limit _ | Unlimited -> let newBalance = accInfo.Balance - paymentAmount let updatedCard = { card with AccountDetails = Active { accInfo with Balance = newBalance } } // note that we have to return balance operation, so it can be stored to DB later. let balanceOperation = { Timestamp = currentDate CardNumber = card.CardNumber NewBalance = newBalance BalanceChange = Decrease paymentAmount } Ok (updatedCard, balanceOperation) ``` This `spentToday` - we'll have to calculate it from `BalanceOperation` collection we'll keep in database. So we'll need module for that, which will basically have 1 public function: ```fsharp let private isDecrease change = match change with | Increase _ -> false | Decrease _ -> true let spentAtDate (date: DateTimeOffset) cardNumber operations = let date = date.Date let operationFilter { CardNumber = number; BalanceChange = change; Timestamp = timestamp } = isDecrease change && number = cardNumber && timestamp.Date = date let spendings = List.filter operationFilter operations List.sumBy (fun s -> -s.BalanceChange.ToDecimal()) spendings |> Money ``` Good. Now that we're done with all the business logic implementation, time to think about mapping. A lot of our types use discriminated unions, some of our types have no public constructor, so we can't expose them as is to the outside world. We'll need to deal with (de)serialization. Besides that, right now we have only one bounded context in our application, but later on in real life you would want to build a bigger system with multiple bounded contexts, and they have to interact with each other through public contracts, which should be comprehensible for everyone, including other programming languages. We have to do both way mapping: from public models to domain and vise versa. While mapping from domain to models is pretty straight forward, the other direction has a bit of a pickle: models can have invalid data, after all we use plain types that can be serialized to json. Don't worry, we'll have to build our validation in that mapping. The very fact that we use different types for possibly invalid data and data, that's **always** valid means, that compiler won't let us forget to execute validation. Here's what it looks like: ```fsharp // You can use type aliases to annotate your functions. This is just an example, but sometimes it makes code more readable type ValidateCreateCardCommand = CreateCardCommandModel -> ValidationResult let validateCreateCardCommand : ValidateCreateCardCommand = fun cmd -> // that's a computation expression for `Result<>` type. // Thanks to this we don't have to chose between short code and straight forward one, // like we have to do in C# result { let! name = LetterString.create "name" cmd.Name let! number = CardNumber.create "cardNumber" cmd.CardNumber let! month = Month.create "expirationMonth" cmd.ExpirationMonth let! year = Year.create "expirationYear" cmd.ExpirationYear return { Card.CardNumber = number Name = name HolderId = cmd.UserId Expiration = month,year AccountDetails = AccountInfo.Default cmd.UserId |> Active } } ``` Full module for mappings and validations is [here](https://github.com/atsapura/CardManagement/blob/master/CardManagement/CardDomainCommandModels.fs) and module for mapping to models is [here](https://github.com/atsapura/CardManagement/blob/master/CardManagement/CardDomainQueryModels.fs). At this point we have implementation for all the business logic, mappings, validation and so on, and so far all of this is completely isolated from real world: it's written in pure functions entirely. Now you're maybe wondering, how exactly are we gonna make use of this? Because we do have to interact with outside world. More than that, during a workflow execution we have to make some decisions based on outcome of those real-world interactions. So the question is how do we assemble all of this? In OOP they use IoC containers to take care of that, but here we can't do that, since we don't even have objects, we have static functions. We are gonna use `Interpreter pattern` for that! It's a bit tricky, mostly because it's unfamiliar, but I'll do my best to explain this pattern. First, let's talk about function composition. For instance we have a function `int -> string`. This means that function expects `int` as a parameter and returns string. Now let's say we have another function `string -> char`. At this point we can chain them, i.e. execute first one, take it's output and feed it to the second function, and there's even an operator for that: `>>`. Here's how it works: ```fsharp let intToString (i: int) = i.ToString() let firstCharOrSpace (s: string) = match s with | (null| "") -> ' ' | s -> s.[0] let firstDigitAsChar = intToString >> firstCharOrSpace // And you can chain as many functions as you like let alwaysTrue = intToString >> firstCharOrSpace >> Char.IsDigit ``` However we can't use simple chaining in some scenarios, e.g. activating card. Here's a sequence of actions: - validate input card number. If it's valid, then - try to get card by this number. If there's one - activate it. - save results. If it's ok then - map to model and return. The first two steps have that `If it's ok then...`. That's the reason why direct chaining is not working. We could simply inject as parameters those functions, like this: ```fsharp let activateCard getCardAsync saveCardAsync cardNumber = ... ``` But there're certain problems with that. First, number of dependencies can grow big and function signature will look ugly. Second, we are tied to specific effects in here: we have to choose if it's a `Task` or `Async` or just plain sync calls. Third, it's easy to mess things up when you have that many functions to pass: e.g. `createUserAsync` and `replaceUserAsync` have same signature but different effects, so when you have to pass them hundreds of times you can make a mistake with really weird symptoms. Because of those reasons we go for interpreter. The idea is that we divide our composition code in 2 parts: execution tree and interpreter for that tree. Every node in this tree is a place for a function with effect we want to inject, like `getUserFromDatabase`. Those nodes are defined by name, e.g. `getCard`, input parameter type, e.g. `CardNumber` and return type, e.g. `Card option`. We don't specify here `Task` or `Async`, that's not the part of the tree, _it's a part of interpreter_. Every edge of this tree is some series of pure transformations, like validation or business logic function execution. The edges also have some input, e.g. raw string card number, then there's validation, which can give us an error or a valid card number. If there's an error, we are gonna interrupt that edge, if not, it leads us to the next node: `getCard`. If this node will return `Some card`, we can continue to the next edge, which would be activation, and so on. For every scenario like `activateCard` or `processPayment` or `topUp` we are gonna build a separate tree. When those trees are built, their nodes are kinda blank, they don't have real functions in them, _they have a place_ for those functions. The goal of interpreter is to fill up those nodes, simple as that. Interpreter knows effects we use, e.g. `Task`, and it knows which real function to put in a given node. When it visits a node, it executes corresponding real function, awaits it in case of `Task` or `Async`, and passes the result to the next edge. That edge may lead to another node, and then it's a work for interpreter again, until this interpreter reaches the stop node, the bottom of our recursion, where we just return the result of the whole execution of our tree. The whole tree would be represented with discriminated union, and a node would look like this: ```fsharp type Program<'a> = | GetCard of CardNumber * (Card option -> Program<'a>) // <- THE NODE | ... // ANOTHER NODE ``` It's always gonna be a tuple, where the first element is an input for your dependency, and the last element is a _function_, which receives the result of that dependency. That "space" between those elements of tuple is where your dependency will fit in, like in those composition examples, where you have function `'a -> 'b`, `'c -> 'd` and you need to put another one `'b -> 'c` in between to connect them. Since we are inside of our bounded context, we shouldn't have too many dependencies, and if we do - it's probably a time to split our context into smaller ones. Here's what it looks like, full source is [here](https://github.com/atsapura/CardManagement/blob/master/CardManagement/CardProgramBuilder.fs): ```fsharp type Program<'a> = | GetCard of CardNumber * (Card option -> Program<'a>) | GetCardWithAccountInfo of CardNumber * ((Card*AccountInfo) option -> Program<'a>) | CreateCard of (Card*AccountInfo) * (Result -> Program<'a>) | ReplaceCard of Card * (Result -> Program<'a>) | GetUser of UserId * (User option -> Program<'a>) | CreateUser of UserInfo * (Result -> Program<'a>) | GetBalanceOperations of (CardNumber * DateTimeOffset * DateTimeOffset) * (BalanceOperation list -> Program<'a>) | SaveBalanceOperation of BalanceOperation * (Result -> Program<'a>) | Stop of 'a // This bind function allows you to pass a continuation for current node of your expression tree // the code is basically a boiler plate, as you can see. let rec bind f instruction = match instruction with | GetCard (x, next) -> GetCard (x, (next >> bind f)) | GetCardWithAccountInfo (x, next) -> GetCardWithAccountInfo (x, (next >> bind f)) | CreateCard (x, next) -> CreateCard (x, (next >> bind f)) | ReplaceCard (x, next) -> ReplaceCard (x, (next >> bind f)) | GetUser (x, next) -> GetUser (x,(next >> bind f)) | CreateUser (x, next) -> CreateUser (x,(next >> bind f)) | GetBalanceOperations (x, next) -> GetBalanceOperations (x,(next >> bind f)) | SaveBalanceOperation (x, next) -> SaveBalanceOperation (x,(next >> bind f)) | Stop x -> f x // this is a set of basic functions. Use them in your expression tree builder to represent dependency call let stop x = Stop x let getCardByNumber number = GetCard (number, stop) let getCardWithAccountInfo number = GetCardWithAccountInfo (number, stop) let createNewCard (card, acc) = CreateCard ((card, acc), stop) let replaceCard card = ReplaceCard (card, stop) let getUserById id = GetUser (id, stop) let createNewUser user = CreateUser (user, stop) let getBalanceOperations (number, fromDate, toDate) = GetBalanceOperations ((number, fromDate, toDate), stop) let saveBalanceOperation op = SaveBalanceOperation (op, stop) ``` With a help of [computation expressions](https://fsharpforfunandprofit.com/series/computation-expressions.html), we now have a very easy way to build our workflows without having to care about implementation of real-world interactions. We do that in [CardWorkflow module](https://github.com/atsapura/CardManagement/blob/master/CardManagement/CardWorkflow.fs): ```fsharp // `program` is the name of our computation expression. // In every `let!` binding we unwrap the result of operation, which can be // either `Program<'a>` or `Program>`. What we unwrap would be of type 'a. // If, however, an operation returns `Error`, we stop the execution at this very step and return it. // The only thing we have to take care of is making sure that type of error is the same in every operation we call let processPayment (currentDate: DateTimeOffset, payment) = program { (* You can see these `expectValidationError` and `expectDataRelatedErrors` functions here. What they do is map different errors into `Error` type, since every execution branch must return the same type, in this case `Result<'a, Error>`. They also help you quickly understand what's going on in every line of code: validation, logic or calling external storage. *) let! cmd = validateProcessPaymentCommand payment |> expectValidationError let! card = tryGetCard cmd.CardNumber let today = currentDate.Date |> DateTimeOffset let tomorrow = currentDate.Date.AddDays 1. |> DateTimeOffset let! operations = getBalanceOperations (cmd.CardNumber, today, tomorrow) let spentToday = BalanceOperation.spentAtDate currentDate cmd.CardNumber operations let! (card, op) = CardActions.processPayment currentDate spentToday card cmd.PaymentAmount |> expectOperationNotAllowedError do! saveBalanceOperation op |> expectDataRelatedErrorProgram do! replaceCard card |> expectDataRelatedErrorProgram return card |> toCardInfoModel |> Ok } ``` This module is the last thing we need to implement in business layer. Also, I've done some refactoring: I moved errors and common types to [Common project](https://github.com/atsapura/CardManagement/tree/master/CardManagement.Common). About time we moved on to implementing data access layer. ### Data access layer The design of entities in this layer may depend on our database or framework we use to interact with it. Therefore domain layer doesn't know anything about these entities, which means we have to take care of mapping to and from domain models in here. Which is quite convenient for consumers of our DAL API. For this application I've chosen MongoDB, not because it's a best choice for this kind of task, but because there're many examples of using SQL DBs already and I wanted to add something different. We are gonna use C# driver. For the most part it's gonna be pretty straight forward, the only tricky moment is with `Card`. When it's active it has an `AccountInfo` inside, when it's not it doesn't. So we have to split it in two documents: `CardEntity` and `CardAccountInfoEntity`, so that deactivating card doesn't erase information about balance and daily limit. Other than that we just gonna use primitive types instead of discriminated unions and types with built-in validation. There're also few things we need to take care of, since we are using C# library: - Convert `null`s to `Option<'a>` - Catch expected exceptions and convert them to our errors and wrap it in `Result<_,_>` We start with [CardDomainEntities module](https://github.com/atsapura/CardManagement/blob/master/CardManagement.Data/CardDomainEntities.fs), where we define our entities: ```fsharp [] type CardEntity = { [] CardNumber: string Name: string IsActive: bool ExpirationMonth: uint16 ExpirationYear: uint16 UserId: UserId } with // we're gonna need this in every entity for error messages member this.EntityId = this.CardNumber.ToString() // we use this Id comparer quotation (F# alternative to C# Expression) for updating entity by id, // since for different entities identifier has different name and type member this.IdComparer = <@ System.Func<_,_> (fun c -> c.CardNumber = this.CardNumber) @> ``` Those fields `EntityId` and `IdComparer` we are gonna use with a help of [SRTP](https://gist.github.com/atsapura/fd9d7aa26e337eaa2f7f04d6cbb58ef6). We'll define functions that will retrieve them from any type that has those fields define, without forcing every entity to implement some interface: ```fsharp let inline (|HasEntityId|) x = fun () -> (^a : (member EntityId: string) x) let inline entityId (HasEntityId f) = f() let inline (|HasIdComparer|) x = fun () -> (^a : (member IdComparer: Quotations.Expr>) x) // We need to convert F# quotations to C# expressions which C# mongo db driver understands. let inline idComparer (HasIdComparer id) = id() |> LeafExpressionConverter.QuotationToExpression |> unbox>> ``` As for `null` and `Option` thing, since we use record types, F# compiler doesn't allow using `null` value, neither for assigning nor for comparison. At the same time record types are just another CLR types, so technically we can and will get a `null` value, thanks to C# and design of this library. We can solve this in 2 ways: use `AllowNullLiteral` attribute, or use `Unchecked.defaultof<'a>`. I went for the second choice since this `null` situation should be localized as much as possible: ```fsharp let isNullUnsafe (arg: 'a when 'a: not struct) = arg = Unchecked.defaultof<'a> // then we have this function to convert nulls to option, therefore we limited this // toxic null thing in here. let unsafeNullToOption a = if isNullUnsafe a then None else Some a ``` In order to deal with expected exception for duplicate key, we use Active Patterns again: ```fsharp // First we define a function which checks, whether exception is about duplicate key let private isDuplicateKeyException (ex: Exception) = ex :? MongoWriteException && (ex :?> MongoWriteException).WriteError.Category = ServerErrorCategory.DuplicateKey // Then we have to check wrapping exceptions for this let rec private (|DuplicateKey|_|) (ex: Exception) = match ex with | :? MongoWriteException as ex when isDuplicateKeyException ex -> Some ex | :? MongoBulkWriteException as bex when bex.InnerException |> isDuplicateKeyException -> Some (bex.InnerException :?> MongoWriteException) | :? AggregateException as aex when aex.InnerException |> isDuplicateKeyException -> Some (aex.InnerException :?> MongoWriteException) | _ -> None // And here's the usage: let inline private executeInsertAsync (func: 'a -> Async) arg = async { try do! func(arg) return Ok () with | DuplicateKey ex -> return EntityAlreadyExists (arg.GetType().Name, (entityId arg)) |> Error } ``` After mapping is implemented we have everything we need to assemble [API for our data access layer](https://github.com/atsapura/CardManagement/blob/master/CardManagement.Data/CardDataPipeline.fs), which looks like this: ```fsharp // `MongoDb` is a type alias for `IMongoDatabase` let replaceUserAsync (mongoDb: MongoDb) : ReplaceUserAsync = fun user -> user |> DomainToEntityMapping.mapUserToEntity |> CommandRepository.replaceUserAsync mongoDb let getUserInfoAsync (mongoDb: MongoDb) : GetUserInfoAsync = fun userId -> async { let! userInfo = QueryRepository.getUserInfoAsync mongoDb userId return userInfo |> Option.map EntityToDomainMapping.mapUserInfoEntity } ``` The last moment I mention is when we do mapping `Entity -> Domain`, we have to instantiate types with built-in validation, so there can be validation errors. In this case we won't use `Result<_,_>` because if we've got invalid data in DB, it's a bug, not something we expect. So we just throw an exception. Other than that nothing really interesting is happening in here. The full source code of data access layer you'll find [here](https://github.com/atsapura/CardManagement/tree/master/CardManagement.Data). ### Composition, logging and all the rest As you remember, we're not gonna use DI framework, we went for interpreter pattern. If you want to know why, here's some reasons: - IoC container operates in runtime. So until you run your program you can't know that all the dependencies are satisfied. - It's a powerful tool which is very easy to abuse: you can do property injection, use lazy dependencies, and sometimes even some business logic can find it's way in dependency registering/resolving (yeah, I've witnessed it). All of that makes code maintaining extremely hard. That means we need a place for that functionality. We could place it on a top level in our Web Api, but in my opinion it's not a best choice: right now we are dealing with only 1 bounded context, but if there's more, this global place with all the interpreters for each context will become cumbersome. Besides, there's single responsibility rule, and web api project should be responsible for web, right? So we create [CardManagement.Infrastructure project](https://github.com/atsapura/CardManagement/tree/master/CardManagement.Infrastructure). Here we will do several things: - Composing our functionality - App configuration - Logging If we had more than 1 context, app configuration and log configuration should be moved to global infrastructure project, and the only thing happening in this project would be assembling API for our bounded context, but in our case this separation is not necessary. Let's get down to composition. We've built execution trees in our domain layer, now we have to interpret them. Every node in that tree represents some dependency call, in our case a call to database. If we had a need to interact with 3rd party api, that would be in here also. So our interpreter has to know how to handle every node in that tree, which is verified in compile time, thanks to `` setting. Here's what it looks like: ```fsharp // Those `bindAsync (next >> interpretCardProgram mongoDb)` work pretty simple: // we execute async function to the left of this expression, await that operation // and pass the result to the next node, after which we interpret that node as well, // until we reach the bottom of this recursion: `Stop a` node. let rec private interpretCardProgram mongoDb prog = match prog with | GetCard (cardNumber, next) -> cardNumber |> getCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetCardWithAccountInfo (number, next) -> number |> getCardWithAccInfoAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | CreateCard ((card,acc), next) -> (card, acc) |> createCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | ReplaceCard (card, next) -> card |> replaceCardAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetUser (id, next) -> getUserAsync mongoDb id |> bindAsync (next >> interpretCardProgram mongoDb) | CreateUser (user, next) -> user |> createUserAsync mongoDb |> bindAsync (next >> interpretCardProgram mongoDb) | GetBalanceOperations (request, next) -> getBalanceOperationsAsync mongoDb request |> bindAsync (next >> interpretCardProgram mongoDb) | SaveBalanceOperation (op, next) -> saveBalanceOperationAsync mongoDb op |> bindAsync (next >> interpretCardProgram mongoDb) | Stop a -> async.Return a let interpret prog = try let interpret = interpretCardProgram (getMongoDb()) interpret prog with | failure -> Bug failure |> Error |> async.Return ``` Note that this interpreter is the place where we have this `async` thing. We can do another interpreter with `Task` or just a plain sync version of it. Now you're probably wondering, how we can cover this with unit-test, since familiar mock libraries ain't gonna help us. Well, it's easy: you have to make another interpreter. Here's what it can look like: ```fsharp type SaveResult = Result type TestInterpreterConfig = { GetCard: Card option GetCardWithAccountInfo: (Card*AccountInfo) option CreateCard: SaveResult ReplaceCard: SaveResult GetUser: User option CreateUser: SaveResult GetBalanceOperations: BalanceOperation list SaveBalanceOperation: SaveResult } let defaultConfig = { GetCard = Some card GetUser = Some user GetCardWithAccountInfo = (card, accountInfo) |> Some CreateCard = Ok() GetBalanceOperations = balanceOperations SaveBalanceOperation = Ok() ReplaceCard = Ok() CreateUser = Ok() } let testInject a = fun _ -> a let rec interpretCardProgram config (prog: Program<'a>) = match prog with | GetCard (cardNumber, next) -> cardNumber |> testInject config.GetCard |> (next >> interpretCardProgram config) | GetCardWithAccountInfo (number, next) -> number |> testInject config.GetCardWithAccountInfo |> (next >> interpretCardProgram config) | CreateCard ((card,acc), next) -> (card, acc) |> testInject config.CreateCard |> (next >> interpretCardProgram config) | ReplaceCard (card, next) -> card |> testInject config.ReplaceCard |> (next >> interpretCardProgram config) | GetUser (id, next) -> id |> testInject config.GetUser |> (next >> interpretCardProgram config) | CreateUser (user, next) -> user |> testInject config.CreateUser |> (next >> interpretCardProgram config) | GetBalanceOperations (request, next) -> testInject config.GetBalanceOperations request |> (next >> interpretCardProgram config) | SaveBalanceOperation (op, next) -> testInject config.SaveBalanceOperation op |> (next >> interpretCardProgram config) | Stop a -> a ``` We've created `TestInterpreterConfig` which holds desired results of every operation we want to inject. You can easily change that config for every given test and then just run interpreter. This interpreter is sync, since there's no reason to bother with `Task` or `Async`. There's nothing really tricky about the logging, but you can find it in [this module](https://github.com/atsapura/CardManagement/blob/master/CardManagement.Infrastructure/Logging.fs). The approach is that we wrap the function in logging: we log function name, parameters and log result. If result is ok, it's info, if error it's a warning and if it's a `Bug` then it's an error. That's pretty much it. One last thing is to make a facade, since we don't want to expose raw interpreter calls. Here's the whole thing: ```fsharp let createUser arg = arg |> (CardWorkflow.createUser >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.createUser") let createCard arg = arg |> (CardWorkflow.createCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.createCard") let activateCard arg = arg |> (CardWorkflow.activateCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.activateCard") let deactivateCard arg = arg |> (CardWorkflow.deactivateCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.deactivateCard") let processPayment arg = arg |> (CardWorkflow.processPayment >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.processPayment") let topUp arg = arg |> (CardWorkflow.topUp >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.topUp") let setDailyLimit arg = arg |> (CardWorkflow.setDailyLimit >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.setDailyLimit") let getCard arg = arg |> (CardWorkflow.getCard >> CardProgramInterpreter.interpret |> logifyResultAsync "CardApi.getCard") let getUser arg = arg |> (CardWorkflow.getUser >> CardProgramInterpreter.interpretSimple |> logifyResultAsync "CardApi.getUser") ``` All the dependencies here are injected, logging is taken care of, no exceptions is thrown - that's it. For web api I used [Giraffe](https://github.com/giraffe-fsharp/Giraffe/blob/master/DOCUMENTATION.md) framework. Web project is [here](https://github.com/atsapura/CardManagement/tree/master/CardManagement.Api/CardManagement.Api). ## Conclusion We have built an application with validation, error handling, logging, business logic - all those things you usually have in your application. The difference is this code is way more durable and easy to refactor. Note that we haven't used reflection or code generation, no exceptions, but still our code isn't verbose. It's easy to read, easy to understand and hard to break. As soon as you add another field in your model, or another case in one of our union types, the code won't compile until you update every usage. Sure it doesn't mean you're totally safe or that you don't need any kind of testing at all, it just means that you're gonna have fewer problems when you develope new features or do some refactoring. The development process will be both cheaper and more interesting, because this tool allows you to focus on your domain and business tasks, instead of drugging focus on keeping an eye out that nothing is broken. Another thing: I don't claim that OOP is completely useless and we don't need it, that's not true. I'm saying that we don't need it for solving _every single task_ we have, and that a big portion of our tasks can be better solved with FP. And truth is, as always, in balance: we can't solve everything efficiently with only one tool, so a good programming language should have a decent support of both FP and OOP. And, unfortunately, a lot of most popular languages today have only lambdas and async programming from functional world. ================================================ FILE: docker/docker-compose.yml ================================================ version: '2.1' services: mongo: image: mongo restart: always environment: MONGO_INITDB_ROOT_USERNAME: root MONGO_INITDB_ROOT_PASSWORD: example ports: - 27017:27017 mem_limit: 200m mongo-express: image: mongo-express restart: always ports: - 27000:8081 environment: ME_CONFIG_MONGODB_ADMINUSERNAME: root ME_CONFIG_MONGODB_ADMINPASSWORD: example depends_on: - mongo mem_limit: 200m