Logging improvement in Fake.Deploy

paket.dependencies

@@ -9,6 +9,7 @@ nuget FSharp.Formatting
 nuget FSharp.Formatting.CommandTool
 nuget SourceLink.Fake
 nuget RavenDB.Server
+nuget serilog.sinks.nlog
 nuget xunit.runners
 nuget UnionArgParser
 nuget Nancy.Authentication.Stateless
@@ -37,4 +38,4 @@ nuget xunit.runners ~> 1.9
 nuget Newtonsoft.Json
 nuget Microsoft.AspNet.Razor 2.0.30506
 nuget Microsoft.AspNet.WebPages 2.0.30506
-nuget HashLib
+nuget HashLib

paket.lock

@@ -66,12 +66,17 @@ NUGET
       Microsoft.AspNet.Razor (>= 2.0.30506) - framework: >= net40
       Nancy (>= 1.2.0)
     Newtonsoft.Json (7.0.1)
+    NLog (4.0.1)
     NuGet.CommandLine (2.8.6)
     NuGet.Core (2.8.6)
       Microsoft.Web.Xdt (>= 2.1.0)
     RavenDB.Client (2.5.2962)
       Microsoft.CompilerServices.AsyncTargetingPack
     RavenDB.Server (3.0.3690)
+    Serilog (1.5.9)
+    Serilog.Sinks.NLog (1.5.4)
+      NLog (>= 3.0.0.0)
+      Serilog (>= 1.4.204 < 2.0)
     SourceLink.Fake (1.0.0)
     SSH.NET (2013.4.7)
     System.Web.Razor.Unofficial (2.0.2)

src/app/Fake.Deploy/AppConfig.fs

@@ -1,29 +1,50 @@
 module Fake.AppConfig
 
 open System
+open System.IO
 open System.Configuration
-open System.Collections.Generic
 
 type Authorization = 
     | Off
     | On
 
-let HasKey name =
-    ConfigurationManager.AppSettings.AllKeys 
-    |> Seq.exists(fun key -> key = name)
+let mutable appSettings = ConfigurationManager.AppSettings
+
+let HasKey name = 
+    ConfigurationManager.AppSettings.AllKeys
+    |> Seq.exists (fun key -> key = name)
 
 let Key<'T>(name : string) = 
-    let value = ConfigurationManager.AppSettings.[name]
+    let value = appSettings.[name]
     Convert.ChangeType(value, typedefof<'T>) :?> 'T
 
+let WorkDirectory = 
+    match (HasKey "WorkDirectory") with
+    | false -> "."
+    | true -> Key<string> "WorkDirectory"
+    |> Path.GetFullPath
+
+let LogDirectory = 
+    match (HasKey "LogDirectory") with
+    | false -> WorkDirectory
+    | true -> 
+        let dir = Key<string> "LogDirectory"
+        if dir.StartsWith("~") then dir.Replace("~", WorkDirectory)
+        else dir
+        |> Path.GetFullPath
+
 let AuthorizedKeysFile = Key<string> "AuthorizedKeysFile"
 
-let Authorization = 
+let Authorization =
     let keyName = "Authorization"
     match (HasKey keyName) with
     | false -> Off
-    | true ->
+    | true -> 
         match (Key<string> keyName).ToLower() with
         | "on" -> On
         | "off" -> Off
         | x -> failwith (sprintf "'%s' is not a valid value for Authorization" x)
+
+let ServerName = Key<string> "ServerName"
+
+let Port = Key<string> "Port"

src/app/Fake.Deploy/DeploymentAgent.fs

@@ -1,17 +1,13 @@
 module Fake.DeploymentAgent
 
-open System
 open System.IO
-open System.Diagnostics
 open Fake
 open Fake.DeploymentHelper
 open Fake.DeployAgentModule
 open Nancy
 open Nancy.Hosting.Self
 open Nancy.Security
 
-let mutable private logger : string * EventLogEntryType -> unit = ignore
-
 let getBodyFromNancyRequest (ctx : Nancy.Request) = 
     use ms = new MemoryStream()
     ctx.Body.CopyTo ms
@@ -39,11 +35,15 @@ let  runDeployment workDir (ctx : Nancy.Request) =
     let response = doDeployment scriptFile scriptArguments
     match response with
     | FakeDeployAgentHelper.Success _ -> 
-        logger (sprintf "Successfully deployed %s %s" package.Id package.Version, EventLogEntryType.Information)
+        Logger.info "Successfully deployed %s %s" package.Id package.Version
+    | FakeDeployAgentHelper.Failure failure ->
+        Logger.error "Deployment failed of %s %s failed\r\nDetails:\r\n%A" package.Id package.Version response
+        Logger.info "Failure: %A" failure.Exception
+        Logger.info "Messages for failed deploy:"
+        failure.Messages |> Seq.iter(fun m -> Logger.info "Deploy message: %A IsError:%b %s" m.Timestamp m.IsError m.Message )
     | response -> 
-        logger 
-            (sprintf "Deployment failed of %s %s failed\r\nDetails:\r\n%A" package.Id package.Version response, 
-             EventLogEntryType.Information)
+        Logger.error "Deployment failed of %s %s failed\r\nDetails:\r\n%A" package.Id package.Version response
+
     response |> Json.serialize
 
 
@@ -52,9 +52,7 @@ let createNancyHost uri =
     config.UrlReservations.CreateAutomatically <- true
     new NancyHost(config, uri)
 
-
-let mutable workDir = Path.GetDirectoryName(Uri(typedefof<FakeModule>.Assembly.CodeBase).LocalPath)
-
+let mutable workDir = AppConfig.WorkDirectory
 
 type DeployAgentModule() as http =
     inherit FakeModule("/fake")
@@ -64,38 +62,51 @@ type DeployAgentModule() as http =
         |> FakeDeployAgentHelper.DeploymentResponse.QueryResult
         |> http.Response.AsJson
 
+    let logged f =
+        try
+            f()
+        with
+        | ex ->
+            Logger.errorEx ex "%s" ex.Message
+            reraise()
+
     do
         http.RequiresAuthentication()
 
-
         http.post "/" (fun _ -> 
-            runDeployment workDir http.Request)
-
-        http.get "/deployments/" (fun _ -> 
-            let status = http.Request.Query ?> "status"
-            match status with
-                | "active" -> getActiveReleases workDir
-                | _ -> getAllReleases workDir
-            |> createResponse
+            logged (fun () -> runDeployment workDir http.Request))
+
+        http.get "/deployments/" (fun _ ->
+            logged (fun () -> 
+                let status = http.Request.Query ?> "status"
+                match status with
+                    | "active" -> getActiveReleases workDir
+                    | _ -> getAllReleases workDir
+                |> createResponse
+            )
         )
 
         http.get "/deployments/{app}/" (fun p ->
-            let app = p ?> "app"
-            let status = http.Request.Query ?> "status"
-            match status with
-                | "active" -> 
-                    getActiveReleaseFor workDir app
-                    |> Seq.singleton
-                | _ -> getAllReleasesFor workDir app
-            |> createResponse
+            logged (fun () -> 
+                let app = p ?> "app"
+                let status = http.Request.Query ?> "status"
+                match status with
+                    | "active" -> 
+                        getActiveReleaseFor workDir app
+                        |> Seq.singleton
+                    | _ -> getAllReleasesFor workDir app
+                |> createResponse
+            )
         )
 
         http.put "/deployments/{app}" (fun p ->
-            let version = p ?> "version"
-            let app = p ?> "app"
-            let result = rollbackTo workDir app version
-            http.Response
-                .AsJson result
+            logged (fun () -> 
+                let version = p ?> "version"
+                let app = p ?> "app"
+                let result = rollbackTo workDir app version
+                http.Response
+                    .AsJson result
+            )
         )
 
         http.get "/statistics/" (fun _ -> getStatistics() |> http.Response.AsJson)