marazm.fs

module Cardone.Backoffice.ImageSearch.Extensions.Installers

open Microsoft.Extensions.DependencyInjection
open Microsoft.AspNetCore.Mvc
open Newtonsoft.Json.Serialization
open Newtonsoft.Json
open Newtonsoft.Json.Converters
open Microsoft.AspNetCore.Routing
open System.IO
open Microsoft.AspNetCore.DataProtection
open Cardone.Backoffice.ImageSearch.Extensions.Common;
open System
open System.Linq
open System.Reflection
open Microsoft.AspNetCore.Mvc.ApiExplorer
open Swashbuckle.AspNetCore.Swagger
open Swashbuckle.AspNetCore.SwaggerGen

type optionBuilder() =
    member __.Bind<'a>(opt: 'a option, f) = Option.bind f opt
    member __.Bind<'a,'b when 'a: null>(o: 'a, f: 'a -> 'b option) = 
        Option.bind f (Option.ofObj o)
    member __.Bind<'a,'b when 'a: struct  
                       and 'a :> ValueType 
                       and 'a: (new: unit -> 'a)> (o: Nullable<'a>, f: 'a -> 'b option) =
        Option.bind f (Option.ofNullable o)
    member __.Return x = Some x
    member __.ReturnFrom x = x
    member __.Zero() = None
    member __.Delay f = f()
        
let option = new optionBuilder()

let inline (^) f x = f x
let inline safeGet f = 
    try Some(f())
    with :? NullReferenceException -> None

type SwaggerDefaultValues () =
    interface IOperationFilter with
        member __.Apply(operation: Operation, context: OperationFilterContext) =
            safeGet ^fun _ -> operation.Parameters
            |> Option.map ^fun x -> x.OfType<NonBodyParameter>()
            |> Option.defaultValue Seq.empty
            |> Seq.iter ^fun parameter -> 
                option {
                    let! paramDescription = 
                        context.ApiDescription.ParameterDescriptions
                        |> Seq.tryFind ^fun x -> x.Name = parameter.Name
                    let! description = safeGet ^fun _ -> paramDescription.ModelMetadata.Description
                    do if isNull parameter.Description then parameter.Description <- description

                    let! routeInfo = paramDescription.RouteInfo
                    do if isNull parameter.Default then parameter.Default <- routeInfo.DefaultValue
                    do parameter.Required <- parameter.Required || (not routeInfo.IsOptional)
                } |> Option.iter id
           
type IServiceCollection with
    member services.installMvc (?mvcAction) =
        let builder = 
            mvcAction
            |> Option.map services.AddMvcCore
            |> Option.defaultValue (services.AddMvcCore())
        
        builder
            .SetCompatibilityVersion(CompatibilityVersion.Version_2_1)
            .AddJsonFormatters()
            .AddJsonOptions(fun (options : MvcJsonOptions) ->
                options.AllowInputFormatterExceptionMessages <- false
                options.SerializerSettings.ContractResolver <- CamelCasePropertyNamesContractResolver()
                options.SerializerSettings.DateFormatHandling <- DateFormatHandling.IsoDateFormat
                options.SerializerSettings.ReferenceLoopHandling <- ReferenceLoopHandling.Ignore
                options.SerializerSettings.Converters.Add(
                    StringEnumConverter(
                        AllowIntegerValues = true, 
                        CamelCaseText = true)))
            .AddApiExplorer()
            .AddDataAnnotations()
        |> ignore
        
        services
            .Configure(fun (options : RouteOptions) ->
                options.LowercaseUrls <- true
                options.AppendTrailingSlash <- false
                ())
            .AddHttpContextAccessor()
        |> ignore
        
        services

    member services.installDataProtection
        ( NotNullOrEmpty "applicationDiscriminator" applicationDiscriminator, 
          NotNullOrEmpty "dataProtectionDirectory" dataProtectionDirectory ) =
            let directory = DirectoryInfo dataProtectionDirectory
            if not(directory.Exists) 
                then failwith "Директория, используемая для механизма DataProtection не существует!"
            
            services.AddDataProtection(fun options -> 
                options.ApplicationDiscriminator <- applicationDiscriminator)
                .PersistKeysToFileSystem(directory)
            |> ignore
            
            services

    member services.installSwagger 
        (serviceTitle : string,
         [<ParamArray>] docsAssemblies : Assembly[]) =

        let getXmlDocFile (typeToGetDoc : Assembly) = 
            let typeAssemblyFile = FileInfo typeToGetDoc.Location
            let typeDirectory = DirectoryInfo typeAssemblyFile.Directory.FullName
            let xmlDocFilePath = Path.Combine(typeDirectory.FullName, Path.GetFileNameWithoutExtension(typeAssemblyFile.Name) + ".xml")
            let xmlDocFile = FileInfo xmlDocFilePath
            if not(xmlDocFile.Exists)
                then failwithf "Не удалось найти файл XML-документации. Ожидаемый путь: %s" xmlDocFile.FullName
            xmlDocFile.FullName

        let getXmlDocFiles (assemblies : Assembly[]) = 
            assemblies
                |> Seq.map getXmlDocFile 
                |> Seq.distinct
                |> Seq.sort
                |> Seq.toArray

        let xmlDocFiles = getXmlDocFiles docsAssemblies
        services.AddSwaggerGen(fun options ->
            let provider = services.BuildServiceProvider().GetRequiredService<IApiVersionDescriptionProvider>()
            for description in provider.ApiVersionDescriptions do
                options.SwaggerDoc(
                    description.GroupName, 
                    Info(
                        Title = sprintf "%s %s" serviceTitle (description.ApiVersion.ToString()),
                        Version = description.ApiVersion.ToString()))
            for xmlDoc in xmlDocFiles do
                options.IncludeXmlComments(xmlDoc)

        ) |> ignore

        services