-
Notifications
You must be signed in to change notification settings - Fork 588
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #1746 from vlukash/vlukash/http_downloader
Add HTTP module for downloading files
- Loading branch information
Showing
9 changed files
with
310 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,17 @@ | ||
| // Auto-Generated by FAKE; do not edit | ||
| namespace System | ||
| open System.Reflection | ||
|
|
||
| [<assembly: AssemblyTitleAttribute("FAKE - F# Make HTTP Client")>] | ||
| [<assembly: AssemblyProductAttribute("FAKE - F# Make")>] | ||
| [<assembly: AssemblyVersionAttribute("5.0.0")>] | ||
| [<assembly: AssemblyInformationalVersionAttribute("5.0.0-beta010")>] | ||
| [<assembly: AssemblyFileVersionAttribute("5.0.0")>] | ||
| do () | ||
|
|
||
| module internal AssemblyVersionInformation = | ||
| let [<Literal>] AssemblyTitle = "FAKE - F# Make HTTP Client" | ||
| let [<Literal>] AssemblyProduct = "FAKE - F# Make" | ||
| let [<Literal>] AssemblyVersion = "5.0.0" | ||
| let [<Literal>] AssemblyInformationalVersion = "5.0.0-beta010" | ||
| let [<Literal>] AssemblyFileVersion = "5.0.0" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,26 @@ | ||
| namespace Fake.Net.Async | ||
|
|
||
| module Async = | ||
| let result = async.Return | ||
| let map f value = async { | ||
| let! v = value | ||
| return f v | ||
| } | ||
|
|
||
| let bind f xAsync = async { | ||
| let! x = xAsync | ||
| return! f x | ||
| } | ||
|
|
||
| let apply fAsync xAsync = async { | ||
| // start the two asyncs in parallel | ||
| let! fChild = Async.StartChild fAsync | ||
| let! xChild = Async.StartChild xAsync | ||
|
|
||
| // wait for the results | ||
| let! f = fChild | ||
| let! x = xChild | ||
|
|
||
| // apply the function to the results | ||
| return f x | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,27 @@ | ||
| <Project Sdk="Microsoft.NET.Sdk" ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> | ||
| <PropertyGroup> | ||
| <VersionPrefix>1.0.0-alpha-10</VersionPrefix> | ||
| <TargetFrameworks>net46;netstandard1.6;netstandard2.0</TargetFrameworks> | ||
| <DebugType>pdbonly</DebugType> | ||
| <GenerateDocumentationFile>true</GenerateDocumentationFile> | ||
| <AssemblyName>Fake.Net.Http</AssemblyName> | ||
| <OutputType>Library</OutputType> | ||
| </PropertyGroup> | ||
| <PropertyGroup> | ||
| <DefineConstants>$(DefineConstants);NETSTANDARD;USE_HTTPCLIENT</DefineConstants> | ||
| </PropertyGroup> | ||
| <PropertyGroup Condition=" '$(Configuration)' == 'Release' "> | ||
| <DefineConstants>$(DefineConstants);RELEASE</DefineConstants> | ||
| </PropertyGroup> | ||
| <ItemGroup> | ||
| <Compile Include="AssemblyInfo.fs" /> | ||
| <Compile Include="Async.fs" /> | ||
| <Compile Include="Result.fs" /> | ||
| <Compile Include="List.fs" /> | ||
| <Compile Include="HttpLoader.fs" /> | ||
| </ItemGroup> | ||
| <ItemGroup> | ||
| <ProjectReference Include="..\Fake.Core.Tracing\Fake.Core.Tracing.fsproj" /> | ||
| </ItemGroup> | ||
| <Import Project="..\..\..\.paket\Paket.Restore.targets" /> | ||
| </Project> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,138 @@ | ||
| namespace Fake.Net | ||
|
|
||
| open System | ||
| open System.IO | ||
| open System.Net.Http | ||
|
|
||
| open Fake.Core | ||
|
|
||
| open Fake.Net.Async | ||
| open Fake.Net.Result | ||
| open Fake.Net.List | ||
|
|
||
| /// HTTP Client for downloading files | ||
| module Http = | ||
|
|
||
| /// Input parameter type | ||
| type DownloadParameters = { | ||
| Uri: string | ||
| Path: string | ||
| } | ||
|
|
||
| /// Type aliases for local file path and error messages | ||
| type private FilePath = string | ||
| type private Err = string | ||
|
|
||
| /// Contains validated Uri and FilePath info for further download | ||
| type private DownloadInfo = { | ||
| Uri: Uri | ||
| LocalFilePath: FilePath | ||
| } | ||
|
|
||
| /// [omit] | ||
| let private createFilePath (filePathStr: string): Result<FilePath, Err list> = | ||
| try | ||
| let fullPath = Path.GetFullPath(filePathStr) | ||
| Ok (fullPath) | ||
| with | ||
| | ex -> | ||
| let err = sprintf "[%s] %s" filePathStr ex.Message | ||
| Error [err ] | ||
|
|
||
| /// [omit] | ||
| let private createUri (uriStr: string): Result<Uri, Err list> = | ||
| try | ||
| Ok (Uri uriStr) | ||
| with | ||
| | ex -> | ||
| let err = sprintf "[%s] %s" uriStr ex.Message | ||
| Error [err ] | ||
|
|
||
| /// [omit] | ||
| let private createDownloadInfo (input: DownloadParameters): Result<DownloadInfo, Err list> = | ||
| let (<!>) = Result.map | ||
| let (<*>) = Result.apply | ||
|
|
||
| let createDownloadInfoRecord (filePath: FilePath) (uri:Uri) = | ||
| { Uri=uri; LocalFilePath=filePath } | ||
|
|
||
| let filePathResult = createFilePath input.Path | ||
| let urlResult = createUri input.Uri | ||
| createDownloadInfoRecord <!> filePathResult <*> urlResult | ||
|
|
||
| /// [omit] | ||
| let private printDownloadResults result = | ||
| match result with | ||
| | Ok result -> | ||
| Trace.log <| sprintf "Downloaded : [%A]" result | ||
| | Error errs -> | ||
| Trace.traceError <| sprintf "Failed: %A" errs | ||
| result | ||
|
|
||
| /// [omit] | ||
| let private saveStreamToFileAsync (filePath: FilePath) (stream: Stream) : Async<Result<FilePath, Err list>> = | ||
| async { | ||
| try | ||
| use fileStream = new FileStream(filePath, FileMode.Create, FileAccess.Write, FileShare.None) | ||
| do! stream.CopyToAsync(fileStream) |> Async.AwaitTask | ||
| return (Ok filePath) | ||
| with | ||
| | ex -> | ||
| let err = sprintf "[%s] %s" filePath ex.Message | ||
| return Error [err ] | ||
| } | ||
|
|
||
| /// [omit] | ||
| let private downloadStreamToFileAsync (info: DownloadInfo) : Async<Result<FilePath, Err list>> = | ||
| async { | ||
| use client = new HttpClient() | ||
| try | ||
| Trace.log <| sprintf "Downloading [%s] ..." info.Uri.OriginalString | ||
| // do not buffer the response | ||
| let! response = client.GetAsync(info.Uri, HttpCompletionOption.ResponseHeadersRead) |> Async.AwaitTask | ||
| response.EnsureSuccessStatusCode () |> ignore | ||
| use! stream = response.Content.ReadAsStreamAsync() |> Async.AwaitTask | ||
| return! saveStreamToFileAsync info.LocalFilePath stream | ||
| with | ||
| | ex -> | ||
| let err = sprintf "[%s] %s" info.Uri.Host ex.Message | ||
| return Error [err ] | ||
| } | ||
|
|
||
| /// [omit] | ||
| let private downloadFileAsync (input: DownloadParameters): Async<Result<FilePath, Err list>> = | ||
| let valImp = createDownloadInfo input | ||
| match valImp with | ||
| | Ok x -> | ||
| downloadStreamToFileAsync x | ||
| | Error errs -> | ||
| Async.result (Error errs) | ||
|
|
||
| /// Download file by the given file path and Uri | ||
| /// string -> string -> Result<FilePath,string list> | ||
| /// ## Parameters | ||
| /// - `localFilePath` - A local file path to download file | ||
| /// - `uri` - A Uri to download from | ||
| /// ## Returns | ||
| /// - `Result` type. Success branch contains a downloaded file path. Failure branch contains a list of errors | ||
| let downloadFile (localFilePath: string) (uri: string) : Result<string, string list> = | ||
| downloadFileAsync { Uri=uri; Path=localFilePath } | ||
| |> Async.RunSynchronously | ||
| |> printDownloadResults | ||
|
|
||
| /// Download list of Uri's in parallel | ||
| /// DownloadParameters -> Result<FilePath, Err list> | ||
| /// ## Parameters | ||
| /// - `input` - List of Http.DownloadParameters. Each Http.DownloadParameters record type contains Uri and file path | ||
| /// ## Returns | ||
| /// - `Result` type. Success branch contains a list of downloaded file paths. Failure branch contains a list of errors | ||
| let downloadFiles (input: DownloadParameters list) : Result<string list, string list> = | ||
| input | ||
| // DownloadParameters -> "Async<Result<FilePath, Err list>> list" | ||
| |> List.map downloadFileAsync | ||
| // "Async<Result<FilePath, Err list>> list" -> "Async<Result<FilePath, Err list> list>" | ||
| |> List.sequenceAsyncA | ||
| // "Async<Result<FilePath, Err list> list>" -> "Async<Result<FilePath list, Err list>>" | ||
| |> Async.map List.sequenceResultA | ||
| |> Async.RunSynchronously | ||
| |> printDownloadResults |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,56 @@ | ||
| namespace Fake.Net.List | ||
|
|
||
| open Fake.Net.Async | ||
| open Fake.Net.Result | ||
|
|
||
| // List extensions for traversing Result and Async types | ||
| // Functions from fsharpforfunandprofit.com, please see details here: | ||
| // https://fsharpforfunandprofit.com/posts/elevated-world-5/ | ||
| module List = | ||
|
|
||
| /// Map a Async producing function over a list to get a new Async | ||
| /// using applicative style | ||
| /// ('a -> Async<'b>) -> 'a list -> Async<'b list> | ||
| let rec traverseAsyncA f list = | ||
|
|
||
| // define the applicative functions | ||
| let (<*>) = Async.apply | ||
| let retn = Async.result | ||
|
|
||
| // define a "cons" function | ||
| let cons head tail = head :: tail | ||
|
|
||
| // right fold over the list | ||
| let initState = retn [] | ||
| let folder head tail = | ||
| retn cons <*> (f head) <*> tail | ||
|
|
||
| List.foldBack folder list initState | ||
|
|
||
| /// Transform a "list<Async>" into a "Async<list>" | ||
| /// and collect the results using apply. | ||
| let sequenceAsyncA x = traverseAsyncA id x | ||
|
|
||
| /// Map a Result producing function over a list to get a new Result | ||
| /// using applicative style | ||
| /// ('a -> Result<'b>) -> 'a list -> Result<'b list> | ||
| let rec traverseResultA f list = | ||
|
|
||
| // define the applicative functions | ||
| let (<*>) = Result.apply | ||
| let retn = Ok | ||
|
|
||
| // define a "cons" function | ||
| let cons head tail = head :: tail | ||
|
|
||
| // right fold over the list | ||
| let initState = retn [] | ||
| let folder head tail = | ||
| retn cons <*> (f head) <*> tail | ||
|
|
||
| List.foldBack folder list initState | ||
|
|
||
| /// Transform a "list<Result>" into a "Result<list>" | ||
| /// and collect the results using apply. | ||
| let sequenceResultA x = traverseResultA id x | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,24 @@ | ||
| namespace Fake.Net.Result | ||
|
|
||
| module Result = | ||
|
|
||
| type ResultBuilder() = | ||
| member __.Bind(m, f) = | ||
| match m with | ||
| | Error e -> Error e | ||
| | Ok a -> f a | ||
|
|
||
| member __.Return(x) = | ||
| Ok x | ||
|
|
||
| let apply fResult xResult = | ||
| match fResult,xResult with | ||
| | Ok f, Ok x -> | ||
| Ok (f x) | ||
| | Error errs, Ok x -> | ||
| Error errs | ||
| | Ok f, Error errs -> | ||
| Error errs | ||
| | Error errs1, Error errs2 -> | ||
| // concat both lists of errors | ||
| Error (List.concat [errs1; errs2]) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,5 @@ | ||
| group netcore | ||
|
|
||
| FSharp.Core | ||
| NETStandard.Library | ||
| System.Net.Http |