From 363af02e1fc04e3cd2d7daba0bb79f5e081af3d0 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Fri, 28 Sep 2018 21:39:45 +0100 Subject: [PATCH 1/6] Potential fix for Linux For some reason the build fails on Linux, maybe this will fix it. --- .psscripts/build-functions.ps1 | 11 +++++++---- tests/BuildStats.Tests/PackageTests.fs | 3 +-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/.psscripts/build-functions.ps1 b/.psscripts/build-functions.ps1 index a796298..8fc595f 100644 --- a/.psscripts/build-functions.ps1 +++ b/.psscripts/build-functions.ps1 @@ -262,13 +262,16 @@ function Install-NetCoreSdk ($sdkZipPath) .PARAMETER version The zip archive which contains the .NET Core SDK. #> - - $env:DOTNET_INSTALL_DIR = "$pwd\.dotnetsdk" New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force - Add-Type -AssemblyName System.IO.Compression.FileSystem; - [System.IO.Compression.ZipFile]::ExtractToDirectory($sdkZipPath, $env:DOTNET_INSTALL_DIR) + if (Test-IsWindows) { + Expand-Archive -Path $sdkZipPath -DestinationPath $env:DOTNET_INSTALL_DIR + } + else { + tar -xvzf $sdkZipPath -C $env:DOTNET_INSTALL_DIR + } + $env:Path = "$env:DOTNET_INSTALL_DIR;$env:Path" } diff --git a/tests/BuildStats.Tests/PackageTests.fs b/tests/BuildStats.Tests/PackageTests.fs index a289bc6..c21bfba 100644 --- a/tests/BuildStats.Tests/PackageTests.fs +++ b/tests/BuildStats.Tests/PackageTests.fs @@ -157,5 +157,4 @@ let ``Microsoft.Bot.Builder returns correct result``() = false |> runTask - package.Value.Name |> shouldEqual "Microsoft.Bot.Builder" - package.Value.Downloads |> shouldBeGreaterThan 7 \ No newline at end of file + package.Value.Name |> shouldEqual "Microsoft.Bot.Builder" \ No newline at end of file From 4e005e608caf53e89cfb17c4e6a99858801e8665 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Fri, 28 Sep 2018 21:46:09 +0100 Subject: [PATCH 2/6] Another fix Let's try this again. --- .psscripts/build-functions.ps1 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/.psscripts/build-functions.ps1 b/.psscripts/build-functions.ps1 index 8fc595f..d300e77 100644 --- a/.psscripts/build-functions.ps1 +++ b/.psscripts/build-functions.ps1 @@ -262,14 +262,16 @@ function Install-NetCoreSdk ($sdkZipPath) .PARAMETER version The zip archive which contains the .NET Core SDK. #> - $env:DOTNET_INSTALL_DIR = "$pwd\.dotnetsdk" - New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force if (Test-IsWindows) { + $env:DOTNET_INSTALL_DIR = "$pwd\.dotnetsdk" + New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force Expand-Archive -Path $sdkZipPath -DestinationPath $env:DOTNET_INSTALL_DIR } else { - tar -xvzf $sdkZipPath -C $env:DOTNET_INSTALL_DIR + $env:DOTNET_INSTALL_DIR = "$pwd/.dotnetsdk" + New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force + Invoke-Cmd "tar -xvzf $sdkZipPath -C $env:DOTNET_INSTALL_DIR" } $env:Path = "$env:DOTNET_INSTALL_DIR;$env:Path" From 2c667b012d08f2f076566bce3491f1b36e1be594 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Fri, 28 Sep 2018 21:58:21 +0100 Subject: [PATCH 3/6] One more fix Will this eventually work?? --- .psscripts/build-functions.ps1 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/.psscripts/build-functions.ps1 b/.psscripts/build-functions.ps1 index d300e77..88e2dde 100644 --- a/.psscripts/build-functions.ps1 +++ b/.psscripts/build-functions.ps1 @@ -263,15 +263,14 @@ function Install-NetCoreSdk ($sdkZipPath) The zip archive which contains the .NET Core SDK. #> + $env:DOTNET_INSTALL_DIR = [System.Path]::Combine($pwd, ".dotnetsdk") + New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force + if (Test-IsWindows) { - $env:DOTNET_INSTALL_DIR = "$pwd\.dotnetsdk" - New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force Expand-Archive -Path $sdkZipPath -DestinationPath $env:DOTNET_INSTALL_DIR } else { - $env:DOTNET_INSTALL_DIR = "$pwd/.dotnetsdk" - New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force - Invoke-Cmd "tar -xvzf $sdkZipPath -C $env:DOTNET_INSTALL_DIR" + Invoke-Cmd "tar -xzf $sdkZipPath -C $env:DOTNET_INSTALL_DIR" } $env:Path = "$env:DOTNET_INSTALL_DIR;$env:Path" From 8d229cd38fbf9cf39ca2f93f1c2a48623aba07e0 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Fri, 28 Sep 2018 22:05:21 +0100 Subject: [PATCH 4/6] Fixing a broken script Fixing more --- .psscripts/build-functions.ps1 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.psscripts/build-functions.ps1 b/.psscripts/build-functions.ps1 index 88e2dde..38bdd22 100644 --- a/.psscripts/build-functions.ps1 +++ b/.psscripts/build-functions.ps1 @@ -263,7 +263,7 @@ function Install-NetCoreSdk ($sdkZipPath) The zip archive which contains the .NET Core SDK. #> - $env:DOTNET_INSTALL_DIR = [System.Path]::Combine($pwd, ".dotnetsdk") + $env:DOTNET_INSTALL_DIR = [System.IO.Path]::Combine($pwd, ".dotnetsdk") New-Item $env:DOTNET_INSTALL_DIR -ItemType Directory -Force if (Test-IsWindows) { From 265ce64b834426990fc692c40df84b7a3693fa35 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Sun, 30 Sep 2018 15:51:27 +0100 Subject: [PATCH 5/6] Complete rewrite of the HTTP resilience Implemented a custom Http framework for handling errors when making API calls. This should help to fix and diagnose any TravisCI issues. --- build.ps1 | 6 +- src/BuildStats/BuildHistoryCharts.fs | 89 ++++++------- src/BuildStats/BuildStats.fsproj | 3 +- src/BuildStats/Common.fs | 50 +------ src/BuildStats/HttpClients.fs | 123 ++++++++++++++++++ src/BuildStats/PackageServices.fs | 21 ++- src/BuildStats/Program.fs | 14 +- src/BuildStats/Web.fs | 79 +++++++---- .../BuildStats.Tests/BuildStats.Tests.fsproj | 1 + tests/BuildStats.Tests/PackageTests.fs | 18 ++- 10 files changed, 271 insertions(+), 133 deletions(-) create mode 100644 src/BuildStats/HttpClients.fs diff --git a/build.ps1 b/build.ps1 index fdbb788..e34bbdb 100644 --- a/build.ps1 +++ b/build.ps1 @@ -4,8 +4,8 @@ param ( + [string] $Run, [switch] $Release, - [switch] $Run, [switch] $ExcludeTests, [switch] $Docker, [switch] $Deploy, @@ -57,7 +57,7 @@ if ($Docker.IsPresent -or $Deploy.IsPresent -or $env:APPVEYOR_REPO_TAG -eq $true Invoke-Cmd "docker build -t dustinmoris/ci-buildstats:$version $publishFolder" } -if ($Run.IsPresent) +if ($Run) { Write-Host "Launching application..." -ForegroundColor Magenta @@ -67,7 +67,7 @@ if ($Run.IsPresent) } else { - dotnet-run $app "debug" + dotnet-run $app $Run } } elseif ($Deploy.IsPresent) # -or $env:APPVEYOR_REPO_TAG -eq $true) AppVeyor doesn't support Linux containers yet diff --git a/src/BuildStats/BuildHistoryCharts.fs b/src/BuildStats/BuildHistoryCharts.fs index c7a8bfe..94dcbad 100644 --- a/src/BuildStats/BuildHistoryCharts.fs +++ b/src/BuildStats/BuildHistoryCharts.fs @@ -4,11 +4,13 @@ open System open System.Net open System.Net.Http open System.Net.Http.Headers +open Microsoft.Extensions.Logging open Microsoft.FSharp.Core.Option +open FSharp.Control.Tasks.V2.ContextInsensitive open Newtonsoft.Json.Linq open Giraffe -open FSharp.Control.Tasks.V2.ContextInsensitive open BuildStats.Common +open BuildStats.HttpClients // ------------------------------------------- // Common Types and Functions @@ -78,8 +80,7 @@ module BuildMetrics = // AppVeyor // ------------------------------------------- -[] -module AppVeyor = +type AppVeyorHttpClient (httpClient : FallbackHttpClient) = let parseToJArray (json : string) = let obj = Json.deserialize json :?> JObject @@ -114,12 +115,11 @@ module AppVeyor = }) |> Seq.toList - let getBuilds (httpClient : HttpClient) - (authToken : string option) // ToDo - (slug : string * string) - (buildCount : int) - (branch : string option) - (inclFromPullRequest : bool) = + member this.GetBuildsAsync (authToken : string option) + (slug : string * string) + (buildCount : int) + (branch : string option) + (inclFromPullRequest : bool) = task { let account, project = slug let branchFilter = @@ -133,11 +133,11 @@ module AppVeyor = let request = new HttpRequestMessage(HttpMethod.Get, url) - if (authToken.IsSome) then + if authToken.IsSome then let token = AES.decryptUrlEncodedString AES.key authToken.Value request.Headers.Authorization <- AuthenticationHeaderValue("Bearer", token) - let! json = Http.sendRequest httpClient request + let! json = httpClient.SendAsync request return json |> (Str.toOption @@ -151,8 +151,7 @@ module AppVeyor = // TravisCI // ------------------------------------------- -[] -module TravisCI = +type TravisCIHttpClient (httpClient : FallbackHttpClient) = let parseToJArray (json : string) = let obj = Json.deserialize json :?> JObject @@ -188,19 +187,19 @@ module TravisCI = }) |> Seq.toList - let rec getBuilds (forceFallback : bool) - (httpClient : HttpClient) - (authToken : string option) - (slug : string * string) - (buildCount : int) - (branch : string option) - (inclFromPullRequest : bool) = + let rec getBuildsAsync (forceFallback : bool) + (authToken : string option) + (slug : string * string) + (buildCount : int) + (branch : string option) + (inclFromPullRequest : bool) = task { let account, project = slug + let request = new HttpRequestMessage() request.Method <- HttpMethod.Get request.Headers.Add("Travis-API-Version", "3") - request.Headers.TryAddWithoutValidation("User-Agent", "https://buildstats.info") |> ignore + request.Headers.TryAddWithoutValidation("User-Agent", "BuildStats.info-API") |> ignore let topLevelDomain = match forceFallback, authToken with @@ -231,7 +230,7 @@ module TravisCI = request.RequestUri <- new Uri(url) - let! json = Http.sendRequest httpClient request + let! json = httpClient.SendAsync request let builds = json @@ -243,9 +242,8 @@ module TravisCI = return builds else return! - getBuilds + getBuildsAsync true - httpClient authToken slug buildCount @@ -253,12 +251,18 @@ module TravisCI = inclFromPullRequest } + member __.GetBuildsAsync (authToken : string option) + (slug : string * string) + (buildCount : int) + (branch : string option) + (inclFromPullRequest : bool) = + getBuildsAsync false authToken slug buildCount branch inclFromPullRequest + // ------------------------------------------- // CircleCI // ------------------------------------------- -[] -module CircleCI = +type CircleCIHttpClient (httpClient : FallbackHttpClient) = let parseToJArray (json : string) = Json.deserialize json :?> JArray @@ -292,12 +296,11 @@ module CircleCI = }) |> Seq.toList - let getBuilds (httpClient : HttpClient) - (authToken : string option) - (slug : string * string) - (buildCount : int) - (branch : string option) - (inclFromPullRequest : bool) = + member this.GetBuildsAsync (authToken : string option) + (slug : string * string) + (buildCount : int) + (branch : string option) + (inclFromPullRequest : bool) = task { let account, project = slug let branchFilter = @@ -312,7 +315,8 @@ module CircleCI = sprintf "https://circleci.com/api/v1/project/%s/%s%s?limit=%i" account project branchFilter limit - let! json = Http.getJson httpClient url + let request = new HttpRequestMessage(HttpMethod.Get, url) + let! json = httpClient.SendAsync request return json |> (Str.toOption @@ -326,8 +330,7 @@ module CircleCI = // Azure Pipelines // ------------------------------------------- -[] -module AzurePipelines = +type AzurePipelinesHttpClient (httpClient : FallbackHttpClient) = let parseToJArray (json : string) = let obj = Json.deserialize json :?> JObject @@ -362,12 +365,11 @@ module AzurePipelines = }) |> Seq.toList - let getBuilds (httpClient : HttpClient) - (authToken : string option) - (slug : string * string * int) - (buildCount : int) - (branch : string option) - (inclFromPullRequest : bool) = + member this.GetBuildsAsync (authToken : string option) + (slug : string * string * int) + (buildCount : int) + (branch : string option) + (inclFromPullRequest : bool) = task { let account, project, definitionId = slug let branchFilter = @@ -376,14 +378,13 @@ module AzurePipelines = | None -> "" let limit = min 200 (4 * buildCount) - let apiVersion = "4.1" - let url = sprintf "https://dev.azure.com/%s/%s/_apis/build/builds?api-version=%s&definitions=%i&$top=%i%s" account project apiVersion definitionId limit branchFilter - let! json = Http.getJson httpClient url + let request = new HttpRequestMessage(HttpMethod.Get, url) + let! json = httpClient.SendAsync request return json |> (Str.toOption diff --git a/src/BuildStats/BuildStats.fsproj b/src/BuildStats/BuildStats.fsproj index 22c3823..9d42105 100644 --- a/src/BuildStats/BuildStats.fsproj +++ b/src/BuildStats/BuildStats.fsproj @@ -14,8 +14,6 @@ - - @@ -25,6 +23,7 @@ + diff --git a/src/BuildStats/Common.fs b/src/BuildStats/Common.fs index 037465f..e6a268b 100644 --- a/src/BuildStats/Common.fs +++ b/src/BuildStats/Common.fs @@ -3,16 +3,12 @@ module BuildStats.Common open System open System.IO open System.Text -open System.Text.RegularExpressions open System.Net open System.Net.Http open System.Security.Cryptography open Newtonsoft.Json -open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Authentication open FSharp.Control.Tasks.V2.ContextInsensitive -open Polly -open Polly.Extensions.Http // ------------------------------------- // String helper functions @@ -43,29 +39,6 @@ module Json = let deserialize (json : string) = JsonConvert.DeserializeObject json -// ------------------------------------- -// Http -// ------------------------------------- - -[] -module Http = - - let getJson (httpClient : HttpClient) (url : string) = - task { - let! response = httpClient.GetAsync url - match response.StatusCode with - | HttpStatusCode.OK -> return! response.Content.ReadAsStringAsync() - | _ -> return "" - } - - let sendRequest (httpClient : HttpClient) (request : HttpRequestMessage) = - task { - let! response = httpClient.SendAsync request - match response.StatusCode with - | HttpStatusCode.OK -> return! response.Content.ReadAsStringAsync() - | _ -> return "" - } - // ------------------------------------- // Cryptography // ------------------------------------- @@ -179,25 +152,4 @@ module Css = |> getMinifiedContent |> sb.AppendLine ) (new StringBuilder()) - result.ToString() - -// ------------------------------------- -// HTTP Client -// ------------------------------------- - -[] -module HttpClientConfig = - let defaultClientName = "DefaultHttpClient" - - let tooManyRequestsPolicy = - Policy - .Handle() - .OrResult( - fun (msg : HttpResponseMessage) -> - msg.StatusCode.Equals StatusCodes.Status429TooManyRequests) - .WaitAndRetryAsync( - [ - TimeSpan.FromSeconds(1.0) - TimeSpan.FromSeconds(3.0) - TimeSpan.FromSeconds(5.0) - ]) \ No newline at end of file + result.ToString() \ No newline at end of file diff --git a/src/BuildStats/HttpClients.fs b/src/BuildStats/HttpClients.fs new file mode 100644 index 0000000..5818775 --- /dev/null +++ b/src/BuildStats/HttpClients.fs @@ -0,0 +1,123 @@ +module BuildStats.HttpClients + +open System +open System.Net +open System.Net.Http +open System.Threading.Tasks +open Microsoft.Extensions.Logging +open FSharp.Control.Tasks.V2.ContextInsensitive +open System.Net.Http.Headers + +exception BrokenCircuitException + +type IResilientHttpClient = + abstract member SendAsync : HttpRequestMessage -> Task + +type BaseHttpClient (clientFactory : IHttpClientFactory) = + interface IResilientHttpClient with + member __.SendAsync (request : HttpRequestMessage) = + let client = clientFactory.CreateClient() + client.SendAsync request + +type CircuitBreakerHttpClient (httpClient : IResilientHttpClient, + logger : ILogger, + minBreakDuration : TimeSpan) = + + let mutable isBrokenCircuit = false + let mutable brokenSince = DateTime.MinValue + + let getBreakDuration (response : HttpResponseMessage) = + match response.Headers.RetryAfter.Delta.HasValue with + | true -> max minBreakDuration response.Headers.RetryAfter.Delta.Value + | false -> minBreakDuration + + let isClientError (status : HttpStatusCode) = + let clientErrorCodes = + [ 400; 401; 402; 403; 404; 405; 406; 407; 409; 410; + 411; 412; 413; 414; 415; 416; 417; 418; 421; 422; + 423; 424; 426; 428; 431; 444; 451; 499 ] + clientErrorCodes |> List.contains ((int)status) + + interface IResilientHttpClient with + member __.SendAsync (request : HttpRequestMessage) = + task { + match isBrokenCircuit with + | true -> + let brokenDuration = DateTime.Now - brokenSince + isBrokenCircuit <- brokenDuration <= minBreakDuration + return raise BrokenCircuitException + | false -> + let! response = httpClient.SendAsync request + match response.IsSuccessStatusCode || isClientError response.StatusCode with + | true -> return response + | false -> + let breakDuration = getBreakDuration response + logger.LogWarning("Request to '{url}' has failed. Breaking circuit for: {seconds}sec.", request.RequestUri, breakDuration.TotalSeconds) + brokenSince <- DateTime.Now + isBrokenCircuit <- true + return response + } + +type RetryHttpClient (httpClient : IResilientHttpClient, + logger : ILogger, + maxRetries : int) = + + let getWaitDuration (retryCount : int) = + TimeSpan.FromSeconds(Math.Pow(2.0, float retryCount)) + + let isWorthRetrying (status : HttpStatusCode) = + status = HttpStatusCode.RequestTimeout + || status = HttpStatusCode.BadGateway + || status = HttpStatusCode.ServiceUnavailable + || status = HttpStatusCode.GatewayTimeout + + let rec sendAsync (request : HttpRequestMessage) (retryCount : int) : Task = + task { + let! response = httpClient.SendAsync request + + match response.IsSuccessStatusCode with + | true -> return response + | false -> + match retryCount > 0 && isWorthRetrying response.StatusCode with + | false -> return response + | true -> + let waitDuration = getWaitDuration retryCount + logger.LogWarning( + "Request to '{url}' has failed. The response status code was: {statusCode}. Max retries left: {retryCount}. Next wait duration: {seconds}sec.", + request.RequestUri, response.StatusCode, retryCount, waitDuration.TotalSeconds) + do! Task.Delay waitDuration + return! sendAsync request (retryCount - 1) + } + + interface IResilientHttpClient with + member __.SendAsync (request : HttpRequestMessage) = + sendAsync request maxRetries + +type FallbackHttpClient (httpClient : IResilientHttpClient, + logger : ILogger) = + + let isClientError (status : HttpStatusCode) = + let clientErrorCodes = + [ 400; 401; 402; 403; 404; 405; 406; 407; 409; 410; + 411; 412; 413; 414; 415; 416; 417; 418; 421; 422; + 423; 424; 426; 428; 431; 444; 451; 499 ] + clientErrorCodes |> List.contains ((int)status) + + member __.SendAsync (request : HttpRequestMessage) = + task { + try + request.Headers.Accept.Add(new MediaTypeWithQualityHeaderValue("application/json")) + let! response = httpClient.SendAsync request + match response.StatusCode with + | HttpStatusCode.OK -> return! response.Content.ReadAsStringAsync() + | _ -> + if isClientError response.StatusCode then + logger.LogWarning("Request to '{url}' has failed due to a HTTP client error: {statusCode}.", request.RequestUri, response.StatusCode) + return "" + with + | :? BrokenCircuitException -> return "" + | ex -> + logger.LogWarning( + "Exception thrown when sending a HTTP request to '{url}': {message}. Stack Trace: {stackTrace}.", request.RequestUri, ex.Message, ex.StackTrace) + return "" + } \ No newline at end of file diff --git a/src/BuildStats/PackageServices.fs b/src/BuildStats/PackageServices.fs index 8334d64..76f7e8f 100644 --- a/src/BuildStats/PackageServices.fs +++ b/src/BuildStats/PackageServices.fs @@ -3,9 +3,10 @@ module BuildStats.PackageServices open System.Net open System.Net.Http open Microsoft.FSharp.Core.Option +open FSharp.Control.Tasks.V2.ContextInsensitive open Newtonsoft.Json.Linq open BuildStats.Common -open FSharp.Control.Tasks.V2.ContextInsensitive +open BuildStats.HttpClients type Package = { @@ -15,6 +16,10 @@ type Package = Downloads : int } +type PackageHttpClient (httpClient : FallbackHttpClient) = + member __.SendAsync request = + httpClient.SendAsync request + module NuGet = let deserialize (json : string) = @@ -33,12 +38,13 @@ module NuGet = Downloads = item.Value "totalDownloads" } - let getPackageAsync (httpClient : HttpClient) + let getPackageAsync (httpClient : PackageHttpClient) (packageName : string) (includePreReleases : bool) = task { let url = sprintf "https://api-v2v3search-0.nuget.org/query?q=%s&skip=0&take=10&prerelease=%b" packageName includePreReleases - let! json = Http.getJson httpClient url + let request = new HttpRequestMessage(HttpMethod.Get, url) + let! json = httpClient.SendAsync request return json |> (Str.toOption @@ -69,7 +75,7 @@ module MyGet = then Some package else None - let getPackageAsync (httpClient : HttpClient) + let getPackageAsync (httpClient : PackageHttpClient) (subDomain : string) (feedName : string, packageName : string) @@ -77,7 +83,8 @@ module MyGet = task { let filter = sprintf "Id eq '%s'" packageName |> WebUtility.UrlEncode let url = sprintf "https://%s.myget.org/F/%s/api/v2/Packages()?$filter=%s&$orderby=Published desc&$top=1" subDomain feedName filter - let! json = Http.getJson httpClient url + let request = new HttpRequestMessage(HttpMethod.Get, url) + let! json = httpClient.SendAsync request return json |> (Str.toOption @@ -86,12 +93,12 @@ module MyGet = >> bind (validatePackage packageName)) } - let getPackageFromOfficialFeedAsync (httpClient : HttpClient) + let getPackageFromOfficialFeedAsync (httpClient : PackageHttpClient) (slug : string * string) (includePreReleases : bool) = getPackageAsync httpClient "www" slug includePreReleases - let getPackageFromEnterpriseFeedAsync (httpClient : HttpClient) + let getPackageFromEnterpriseFeedAsync (httpClient : PackageHttpClient) (slug : string * string * string) (includePreReleases : bool) = let (subDomain, feedName, packageName) = slug diff --git a/src/BuildStats/Program.fs b/src/BuildStats/Program.fs index d63d551..2a20538 100644 --- a/src/BuildStats/Program.fs +++ b/src/BuildStats/Program.fs @@ -10,9 +10,17 @@ open Giraffe [] let main args = let logLevel = - match isNotNull args && args.Length > 0 && args.[0] = "debug" with - | true -> Events.LogEventLevel.Debug - | false -> Events.LogEventLevel.Error + match isNotNull args && args.Length > 0 with + | false -> Events.LogEventLevel.Warning + | true -> + match args.[0] with + | "verbose" -> Events.LogEventLevel.Verbose + | "debug" -> Events.LogEventLevel.Debug + | "info" -> Events.LogEventLevel.Information + | "warning" -> Events.LogEventLevel.Warning + | "error" -> Events.LogEventLevel.Error + | "fatal" -> Events.LogEventLevel.Fatal + | _ -> Events.LogEventLevel.Warning Log.Logger <- (new LoggerConfiguration()) diff --git a/src/BuildStats/Web.fs b/src/BuildStats/Web.fs index 74cb5b7..d25d23d 100644 --- a/src/BuildStats/Web.fs +++ b/src/BuildStats/Web.fs @@ -2,8 +2,8 @@ module BuildStats.Web open System open System.Text -open System.Net.Http open System.Threading.Tasks +open System.Net.Http open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Hosting open Microsoft.AspNetCore.Http @@ -18,6 +18,7 @@ open BuildStats.Common open BuildStats.PackageServices open BuildStats.BuildHistoryCharts open BuildStats.ViewModels +open BuildStats.HttpClients // --------------------------------- // Web app @@ -70,8 +71,7 @@ let notFound msg = setStatusCode 404 >=> text msg let packageHandler getPackageFunc slug = fun (next : HttpFunc) (ctx : HttpContext) -> task { - let httpClientFactory = ctx.GetService() - let httpClient = httpClientFactory.CreateClient(HttpClientConfig.defaultClientName) + let httpClient = ctx.GetService() let preRelease = match ctx.TryGetQueryStringValue "includePreReleases" with @@ -94,7 +94,7 @@ let nugetHandler = packageHandler NuGet.getPackageAsync let mygetOfficialHandler = packageHandler MyGet.getPackageFromOfficialFeedAsync let mygetEnterpriseHandler = packageHandler MyGet.getPackageFromEnterpriseFeedAsync -let getBuildHistory (getBuildsFunc) slug = +let getBuildHistory getBuildsFunc slug = fun (next : HttpFunc) (ctx : HttpContext) -> task { let includePullRequests = @@ -112,11 +112,7 @@ let getBuildHistory (getBuildsFunc) slug = let branch = ctx.TryGetQueryStringValue "branch" let authToken = ctx.TryGetQueryStringValue "authToken" - - let httpClientFactory = ctx.GetService() - let httpClient = httpClientFactory.CreateClient(HttpClientConfig.defaultClientName) - - let! builds = getBuildsFunc httpClient authToken slug buildCount branch includePullRequests + let! builds = getBuildsFunc authToken slug buildCount branch includePullRequests return! builds |> BuildHistoryModel.FromBuilds showStats @@ -126,10 +122,25 @@ let getBuildHistory (getBuildsFunc) slug = <|| (next, ctx) } -let appVeyorHandler = getBuildHistory AppVeyor.getBuilds -let azureHandler = getBuildHistory AzurePipelines.getBuilds -let circleCiHandler = getBuildHistory CircleCI.getBuilds -let travisCiHandler = getBuildHistory (TravisCI.getBuilds false) +let appVeyorHandler slug = + fun (next : HttpFunc) (ctx : HttpContext) -> + let client = ctx.GetService() + getBuildHistory client.GetBuildsAsync slug next ctx + +let azureHandler slug = + fun (next : HttpFunc) (ctx : HttpContext) -> + let client = ctx.GetService() + getBuildHistory client.GetBuildsAsync slug next ctx + +let circleCiHandler slug = + fun (next : HttpFunc) (ctx : HttpContext) -> + let client = ctx.GetService() + getBuildHistory client.GetBuildsAsync slug next ctx + +let travisCiHandler slug = + fun (next : HttpFunc) (ctx : HttpContext) -> + let client = ctx.GetService() + getBuildHistory client.GetBuildsAsync slug next ctx let createHandler : HttpHandler = fun (next : HttpFunc) (ctx : HttpContext) -> @@ -182,9 +193,9 @@ let webApp = route "/ping" >=> text "pong" // SVG endpoints - routef "/nuget/%s" nugetHandler + routef "/nuget/%s" nugetHandler routef "/myget/%s/%s/%s" mygetEnterpriseHandler - routef "/myget/%s/%s" mygetOfficialHandler + routef "/myget/%s/%s" mygetOfficialHandler routef "/appveyor/chart/%s/%s" appVeyorHandler routef "/travisci/chart/%s/%s" travisCiHandler routef "/circleci/chart/%s/%s" circleCiHandler @@ -218,16 +229,38 @@ let configureApp (app : IApplicationBuilder) = .UseResponseCaching() .UseGiraffe(webApp) +let createResilientHttpClient (svc : IServiceProvider) = + new FallbackHttpClient( + new CircuitBreakerHttpClient( + new RetryHttpClient( + new BaseHttpClient( + svc.GetService()), + svc.GetService>(), + maxRetries = 1), + svc.GetService>(), + minBreakDuration = TimeSpan.FromSeconds 1.0), + svc.GetService>()) + let configureServices (services : IServiceCollection) = services + .AddHttpClient() + .AddSingleton( + fun svc -> new TravisCIHttpClient(createResilientHttpClient svc)) + .AddSingleton( + fun svc -> new AppVeyorHttpClient(createResilientHttpClient svc)) + .AddSingleton( + fun svc -> new CircleCIHttpClient(createResilientHttpClient svc)) + .AddSingleton( + fun svc -> new AzurePipelinesHttpClient(createResilientHttpClient svc)) + .AddTransient( + fun svc -> + new PackageHttpClient( + new FallbackHttpClient( + new BaseHttpClient( + svc.GetService()), + svc.GetService>())) + ) .AddResponseCaching() .AddGiraffe() .AddFirewall() - .AddHttpClient( - HttpClientConfig.defaultClientName, - fun client -> - client.DefaultRequestHeaders.Accept.Add(Headers.MediaTypeWithQualityHeaderValue("application/json")) - ) - .SetHandlerLifetime(TimeSpan.FromHours 1.0) - .AddPolicyHandler(HttpClientConfig.tooManyRequestsPolicy) - |> ignore \ No newline at end of file + |> ignore \ No newline at end of file diff --git a/tests/BuildStats.Tests/BuildStats.Tests.fsproj b/tests/BuildStats.Tests/BuildStats.Tests.fsproj index 3af005c..e140d64 100644 --- a/tests/BuildStats.Tests/BuildStats.Tests.fsproj +++ b/tests/BuildStats.Tests/BuildStats.Tests.fsproj @@ -10,6 +10,7 @@ + diff --git a/tests/BuildStats.Tests/PackageTests.fs b/tests/BuildStats.Tests/PackageTests.fs index c21bfba..792647b 100644 --- a/tests/BuildStats.Tests/PackageTests.fs +++ b/tests/BuildStats.Tests/PackageTests.fs @@ -1,15 +1,29 @@ module BuildStats.Tests.PackageTests open System.Net.Http + +open Microsoft.Extensions.Logging +open Microsoft.Extensions.Logging.Console open Xunit open BuildStats.PackageServices +open BuildStats.HttpClients +open NSubstitute /// ------------------------------------- /// Helper functions /// ------------------------------------- -let httpClient = new HttpClient() -httpClient.DefaultRequestHeaders.Accept.Add(Headers.MediaTypeWithQualityHeaderValue("application/json")) +type DefaultHttpClientFactory() = + interface IHttpClientFactory with + member __.CreateClient (name) = + new HttpClient() + +let httpClient = + new PackageHttpClient( + new FallbackHttpClient( + new BaseHttpClient( + new DefaultHttpClientFactory()), + Substitute.For>())) let runTask task = task From 82596de8515197f03c0ed8583a24a1afd296d9d4 Mon Sep 17 00:00:00 2001 From: Dustin Moris Gorski Date: Sun, 30 Sep 2018 16:41:39 +0100 Subject: [PATCH 6/6] Improved look of badges Improved the look of badges --- src/BuildStats/BuildStats.fsproj | 2 +- src/BuildStats/SVGs.fs | 22 ++++++++++++++-------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/BuildStats/BuildStats.fsproj b/src/BuildStats/BuildStats.fsproj index 9d42105..e88f642 100644 --- a/src/BuildStats/BuildStats.fsproj +++ b/src/BuildStats/BuildStats.fsproj @@ -2,7 +2,7 @@ netcoreapp2.1 - 5.3.0 + 5.4.0 BuildStats Exe true diff --git a/src/BuildStats/SVGs.fs b/src/BuildStats/SVGs.fs index db96e10..dda9b27 100644 --- a/src/BuildStats/SVGs.fs +++ b/src/BuildStats/SVGs.fs @@ -31,7 +31,7 @@ let defaultG (fill : string) = let whiteStop (offset : int) (opacity : float) = stop [ attr "offset" (sprintf "%i%%" offset) - attr "style" (sprintf "stop-color: rgb(255, 255, 255); stop-opacity: %.1f" opacity)] + attr "style" (sprintf "stop-color: rgb(240, 240, 240); stop-opacity: %.1f" opacity)] let packageGradient = gradient [ @@ -41,7 +41,7 @@ let packageGradient = attr "x2" "0%" attr "y2" "100%" ] [ - whiteStop 0 0.3 + whiteStop 0 0.15 whiteStop 100 0.0 ] let squareRect (x : int) (y : int) (width : int) (height : int) (fill : string) = @@ -60,19 +60,22 @@ let roundedRect (x : int) (y : int) (width : int) (height : int)(fill : string) attr "y" (y.ToString()) attr "height" (height.ToString()) attr "width" (width.ToString()) - attr "rx" "2" - attr "ry" "2" + attr "rx" "2.5" + attr "ry" "2.5" attr "stroke-width" "0" attr "fill" fill ] -let whiteText (x : int) (y : int) (value : string) = +let colouredText (colour : string) (x : int) (y : int) (value : string) = text [ attr "x" (x.ToString()) attr "y" (y.ToString()) - attr "fill" "#ffffff" + attr "fill" colour ] [ rawText value ] +let whiteText = colouredText "#ffffff" +let blackText = colouredText "#777777" + let packageSVG (model : PackageModel) = [ defaultComment defaultSvg model.Width 20 [ @@ -81,11 +84,11 @@ let packageSVG (model : PackageModel) = [ roundedRect 0 0 (model.Width - 50) 20 - "#333333" + "#444444" squareRect model.FeedWidth 0 (model.VersionWidth) 20 - "#00b359" + "#43ba1b" squareRect (model.FeedWidth + model.VersionWidth) 0 (model.DownloadsWidth - 10) 20 @@ -98,6 +101,9 @@ let packageSVG (model : PackageModel) = [ 0 0 model.Width 20 "url(#grad1)" + + blackText (model.FeedWidth + model.Padding) 15 model.Version + whiteText model.Padding 14 model.FeedName whiteText (model.FeedWidth + model.Padding) 14 model.Version whiteText (model.FeedWidth + model.VersionWidth + model.Padding) 14 model.Downloads ] ] ]